Find and Delete Rows With Duplicate Data

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