Macro for retaining one row of data per person

[Gollum9]

Hi all,

I have a large data set of training information, where there are individual rows per completion. The issue I have is that there can be multiple rows per person as they may have attempted the training before.

What I'm after if possible is some code that will only retain one row of information per person, based on the following rules. The data is in the format of Unique Person ID in column W, the date in column B, and the training status in column T (either passed or failed).

1) Retain only the most recent row for the person that has 'training status' = passed
2) If the person does not have a row with 'training status' = passed, delete all rows other than the most recent row with 'training status' = failed

Thanks for any advice you can provide.

 

[Joe4]

OK, there is one other thing I did not count on, that I think we need some clarification on.
You sometimes have multiple records with the same Date, Status, and Unique Emo ID (like Record IDs 73 and 74 in your example).
In that case, how do we know which record to keep?

 

[Gollum9]

OK, there is one other thing I did not count on, that I think we need some clarification on.
You sometimes have multiple records with the same Date, Status, and Unique Emo ID (like Record IDs 73 and 74 in your example).
In that case, how do we know which record to keep?

Apologies. I should have made that clear. In that instance, the row closest to the top of the list is the one to keep, thanks.

 

[Joe4]

OK, I created VBA code that makes use of column X, putting in a temporary formula which calculates which records to keep, filters them, deleted the unneeded ones, and them removes the filter and gets rid of the temporary column formulas.

Here is the code:

Sub MyDeleteRecords()

    Dim lr As Long
    Dim lRows As Long
    
    Application.ScreenUpdating = False
        
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Add temporary header to column X
    Range("X3") = "Temp"
    
'   Populate column X with temporary formula to identify which records to keep
    Range("X4:X" & lr).FormulaR1C1 = "=IF(COUNTIFS(C[-1],RC[-1],C[-4],""passed"")>0,IF(AND(MAXIFS(C[-22],C[-1],RC[-1],C[-4],""passed"")=RC[-22],RC[-4]=""passed"",COUNTIFS(R4C[-22]:RC[-22],RC[-22],R4C[-4]:RC[-4],RC[-4],R4C[-1]:RC[-1],RC[-1])=1),""keep"",""""),IF(AND(MAXIFS(C[-22],C[-1],RC[-1],C[-4],""failed"")=RC[-22],COUNTIFS(R4C[-22]:RC[-22],RC[-22],R4C[-4]:RC[-4],RC[-4],R4C[-1]:RC[-1],RC[-1])=1),""keep"",""""))"
    
'   Filter column X to hide records to delete
    Range("A3:X" & lr).AutoFilter Field:=24, Criteria1:="<>"

'   Delete unhidden rows
    Application.Calculation = xlCalculationManual
    
    For lRows = ActiveSheet.UsedRange.Rows.Count To 4 Step -1
        If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
    Next lRows
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

'   Turn filter off
    Range("A3:X" & lr).AutoFilter
    
'   Delete temp column
    Range("X3:X" & lr).ClearContents
    
End Sub

Note: In order for this code to work, the dates in column B need to be REAL dates, and not text entries.
They can be formatted in any date format you want, but they need to be valid date entries.
If they are not, we can add lines to the VBA code to convert them to valid dates.

 

[Gollum9]

OK, I created VBA code that makes use of column X, putting in a temporary formula which calculates which records to keep, filters them, deleted the unneeded ones, and them removes the filter and gets rid of the temporary column formulas.

Here is the code:

Sub MyDeleteRecords()

    Dim lr As Long
    Dim lRows As Long
   
    Application.ScreenUpdating = False
       
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Add temporary header to column X
    Range("X3") = "Temp"
   
'   Populate column X with temporary formula to identify which records to keep
    Range("X4:X" & lr).FormulaR1C1 = "=IF(COUNTIFS(C[-1],RC[-1],C[-4],""passed"")>0,IF(AND(MAXIFS(C[-22],C[-1],RC[-1],C[-4],""passed"")=RC[-22],RC[-4]=""passed"",COUNTIFS(R4C[-22]:RC[-22],RC[-22],R4C[-4]:RC[-4],RC[-4],R4C[-1]:RC[-1],RC[-1])=1),""keep"",""""),IF(AND(MAXIFS(C[-22],C[-1],RC[-1],C[-4],""failed"")=RC[-22],COUNTIFS(R4C[-22]:RC[-22],RC[-22],R4C[-4]:RC[-4],RC[-4],R4C[-1]:RC[-1],RC[-1])=1),""keep"",""""))"
   
'   Filter column X to hide records to delete
    Range("A3:X" & lr).AutoFilter Field:=24, Criteria1:="<>"

'   Delete unhidden rows
    Application.Calculation = xlCalculationManual
   
    For lRows = ActiveSheet.UsedRange.Rows.Count To 4 Step -1
        If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
    Next lRows
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

'   Turn filter off
    Range("A3:X" & lr).AutoFilter
   
'   Delete temp column
    Range("X3:X" & lr).ClearContents
   
End Sub

Note: In order for this code to work, the dates in column B need to be REAL dates, and not text entries.
They can be formatted in any date format you want, but they need to be valid date entries.
If they are not, we can add lines to the VBA code to convert them to valid dates.

Oh wow, thanks. That’s a completely different route to how I was going but it looks great. I will do some testing over the weekend but sure it will be fine.

Thanks so much for your time on this

 

[Joe4]

You are welcome.

If you want a manual route that does not use VBA, you can do the following.
Let's that your data is in a sheet named "Data" and is in the range A4:W100.

1. Place the following formula in cell X4 and copy down to line X100

=IF(COUNTIFS(W:W,W4,T:T,"passed")>0,IF(AND(MAXIFS(B:B,W:W,W4,T:T,"passed")=B4,T4="passed",COUNTIFS(B$4:B4,B4,T$4:T4,T4,W$4:W4,W4)=1),"keep",""),IF(AND(MAXIFS(B:B,W:W,W4,T:T,"failed")=B4,COUNTIFS(B$4:B4,B4,T$4:T4,T4,W$4:W4,W4)=1),"keep",""))

2. Insert a new sheet, and enter this formula in it:

=FILTER(Data!A4:W100,Data!X4:X100="keep")