I have a number of items on Col A on sheet "Outlook reminder" I have wriitten code to delete the first duplicate where the text in Col A is similar (have highlighted those items in Yellow to be deleted 1st duplicate) and retain the final duplicate which is indicated in Red
It would be appreciated if someone could amend my code as it it not delete the items in yellow that contains similar text and retain the final duplicate
See link below contain sample data
I have also posted on Macro to Retain Last Duplicate In Col A where the text is similar
It would be appreciated if someone could amend my code as it it not delete the items in yellow that contains similar text and retain the final duplicate
Code:
Sub KeepLastDuplicate()
Dim lastRow As Long
Dim i As Long, j As Long
Dim matchString As String
Dim matchRow As Long
'Get the last row of data in column A
lastRow = Sheets("outlook reminders").Cells(Rows.Count, "A").End(xlUp).Row
'Loop through each row of data
For i = lastRow To 2 Step -1
'Check if the current row matches the previous row
If InStr(1, Sheets("outlook reminders").Cells(i - 1, "A").Value, Sheets("outlook reminders").Cells(i, "A").Value, vbTextCompare) > 0 Then
'If this is the first match in a group of duplicates, store the row number
If matchString <> Sheets("outlook reminders").Cells(i, "A").Value Then
matchString = Sheets("outlook reminders").Cells(i, "A").Value
matchRow = i
End If
Else 'No match
'If there was a previous match, delete all but the last occurrence
If matchRow > 0 Then
For j = matchRow To i - 1
Sheets("outlook reminders").Rows(j).Delete
i = i - 1 'Adjust the counter to account for the deleted row
lastRow = lastRow - 1 'Adjust the last row variable to account for the deleted row
Next j
matchRow = 0 'Reset the match row variable
End If
matchString = "" 'Reset the match string variable
End If
Next i
End Sub
See link below contain sample data
Dropbox
www.dropbox.com
I have also posted on Macro to Retain Last Duplicate In Col A where the text is similar