Remove duplicate rows based on earlier date

[tpmccarthy]

I have duplicate records that differ only by date. I want to identify the dupes (FN/LN) and remove the record with the earlier date.
I inherited the input process and can't screen the records at input.

Date First Last .....
4/8/22 14:56 Thomas McCarthy .....
4/19/22 2:56 Thomas McCarthy ......

Thanks

 

[Sahak]

Hi Tpmccarthy,
Maybe this?

Sub RemoveDuplicates()
    Application.ScreenUpdating = False
    Dim CntRecs As Long
    CntRecs = Range("A1").Offset(Rows.Count - 1, 0).End(xlUp).Row
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(Range("A1"), Range("B1").Offset(CntRecs - 1))
        .Apply
    End With
    ActiveSheet.Range(Range("A1"), Range("B1").Offset(CntRecs - 1)).RemoveDuplicates Columns:=2, Header:=xlYes
End Sub

 

[tpmccarthy]

Thanks. I may not have explained properly (I'm just getting back into this stuff in a number of years)
I want to remove the entire row if B (first name) and C (Last name) match. I need to KEEP the record with the later date.

Date	f name	l name
4/8/22 14:56	Thomas	McCarthy
5/19/22 2:15	Thomas	McCarthy

 

[Sahak]

Hi T@pmccarthy,
Maybe this?

Sub RemoveDuplicates_FL_Nms()
    Application.ScreenUpdating = False
    Dim CntRecs As Long
    CntRecs = Range("A1").Offset(Rows.Count - 1, 0).End(xlUp).Row
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(Range("A2"), Range("C2").Offset(CntRecs - 2))
        .Apply
    End With
    ActiveSheet.Range(Range("A1"), Range("C1").Offset(CntRecs - 1)).RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes
End Sub

[ATTACH type="full"]62351[/ATTACH]

 

[tpmccarthy]

Brilliant [COLOR=rgb(0, 0, 0)]Sahak[/COLOR]!
I'll study this a part of my re-training. I'm amazed how about much I've lost in 3-4 year!
Thank you very much. This is a big help

​

 

[Sahak]

You are very welcome, I'm happy to make you feel happy and satisfied.