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