This code will use the collection object to quickly determine if data is a duplicate. It uses the .add method and will return an error if the data is already in the collection and wont be added. We can also use .count method to see if that item was added to the collection or not.
In the example I have a spreadsheet with four columns of data. Each of the four criteria have to be met if it is to be considered a duplicate.
It is import that any filters applied are cleared or the duplicates will not be located properly
Sub find_duplicates()
Dim isvaluenewcollectionitem As New Collection
Dim currentcollectioncount As Long
Dim CellVal As Variant
Dim icount As Long
Dim endrow As Long
Dim irow As Long
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Summary")
.AutoFilter.Sort.SortFields.Clear ' clear the filter
On Error Resume Next
.ShowAllData 'clear the hidden data from the filter
On Error GoTo 0
icount = 0
endrow = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'make sure all rows and columns are hidden for find will not work properly
.Range(.Cells(15, "a"), .Cells(endrow, "a")).Interior.Color = xlNone
For irow = 15 To endrow
CellVal = Range("a" & irow).Value & Range("b" & irow).Value & Range("c" & irow).Value & Range("d" & irow).Value
On Error Resume Next
isvaluenewcollectionitem.Add CellVal, Chr(34) & CellVal & Chr(34)
On Error GoTo 0
If isvaluenewcollectionitem.count > currentcollectioncount Then
currentcollectioncount = isvaluenewcollectionitem.count
Else
icount = icount + 1
Cells(irow, "a").Interior.Color = 65535
End If
Next irow
' 'add this code if you want to delete the duplicate rows
' For irow = endrow To 15 Step -1
' If Range("A" & irow).Interior.Color = 65535 Then
' Rows(irow).Delete
' End If
' Next irow
MsgBox icount & " duplicates found"
End With
End Sub
Coding with Visual Basic 
1 thought on “Find and Delete Rows With Duplicate Data”