Remove Duplicates keeping most recent change

[infinity]

Hey Vbaxers,

I have a spreadsheet that uses code to track changes to company contact information, it copy's and pastes that company information to another sheet in the file. There may be multiple changes for the same company, each change is going to be timestamped using "=NOW()" as to when it was changed. On the sheet, the timestamp is in column A and the potential duplicate company I am looking for is in column H, so if there are two records for the same company in column H, I only want to remove the oldest timestamped record (remove the entire row) and keep the most recent change. Hope that makes sense. Any help is, as always, is much appreciated!

[Paul_Hossler]

Sort Company A-Z and Timestamp New-Old

Start at bottom and delete row N if Company(N) = Company(N-1)

Or attach a small sample workbook

[infinity]

Here is a sample workbook. I have of course stripped all personal information out of it but in this example I have two entries for ABC Truck Driving School and 3 entries for XYZ Truck Driving School each with different time stamps (which are now in column D rather than column A as of my previous post), I only want to keep the most recent record for each of the two schools.

[大灰狼1976]

Sub test()
Dim r&, cnt&, d As Object, rng As Range, s$
With Sheets("Update Master Sheet")
  cnt = .[d65536].End(3).Row
  If cnt <= 2 Then Exit Sub
  Set d = CreateObject("scripting.dictionary")
  For r = 2 To cnt
    s = .Cells(r, 11).Value
    If d.exists(s) Then
      If .Cells(r, 2) > .Cells(d(s), 2) Then
        If rng Is Nothing Then Set rng = Rows(d(s)) Else Set rng = Union(rng, Rows(d(s)))
        d(s) = r
      Else
        If rng Is Nothing Then Set rng = .Rows(r) Else Set rng = Union(rng, .Rows(r))
      End If
    Else
      d(s) = r
    End If
  Next r
  If Not rng Is Nothing Then rng.Delete
End With
End Sub

[Paul_Hossler]

Maybe something like this

Option Explicit
Sub Macro1()

    Const colCompany As Long = 9
    Const colDateTime As Long = 2
    
    Dim dataSheet As Worksheet
    Dim dataAll As Range, dataNoHeaders As Range
    Dim rowCheck As Long
    
    Set dataSheet = Worksheets("Update Master Sheet")
    Set dataAll = dataSheet.Range("C1").CurrentRegion
    Set dataNoHeaders = dataAll.Cells(2, 1).Resize(dataAll.Rows.Count - 1, dataAll.Columns.Count)

    Application.ScreenUpdating = False

    With dataSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=dataNoHeaders.Columns(colCompany), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=dataNoHeaders.Columns(colDateTime), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange dataAll
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    With dataAll
        For rowCheck = .Rows.Count To 3 Step -1
            If .Cells(rowCheck, colCompany).Value = .Cells(rowCheck - 1, colCompany).Value Then
                If .Cells(rowCheck, colDateTime).Value <= .Cells(rowCheck - 1, colDateTime).Value Then
                    .Cells(rowCheck, colCompany).Font.Strikethrough = True  '   for testing - remove and uncoment line below
'                   .Rows(rowCheck).Delete
                End If
            End If
        Next rowCheck
    End With

    Application.ScreenUpdating = True
End Sub

[infinity]

WOW! I have no idea how this works but it certainly does. I sometimes have the delusion that I am good with VBA and then I visit this site, all of you have helped me so much over the years and I am truly grateful. Thank you Paul, much appreciated!

[Paul_Hossler]

WOW! I have no idea how this works but it certainly does. I sometimes have the delusion that I am good with VBA and then I visit this site, all of you have helped me so much over the years and I am truly grateful. Thank you Paul, much appreciated!

It's important to try and understand 'How' it works so ask questions, no matter which approach you decide to use.

After all, six months from now you'll decide you need a fix, change, or enhancement and it's much faster to make it yourself.

A lot of the time, just single stepping through the macro and seeing what each line does can make it a learning experience. Also using the Immediate Window and Watch Window to see what's happening can be very useful

https://www.myonlinetraininghub.com/debugging-vba-code