[IncludeBorders/top.htm]

Deleting Duplicates With Advanced Filter

 

This page has been replaced by a newly updated version.Click here to go to the new page.

If you have a list of data and want to delete duplicates, you can do this with VBA code using Advanced Filter.  The function below, DeleteDuplicatesViaFilter uses Advanced Filter to make visible only unique rows, and then goes through and deletes the hidden rows.
    Function DeleteDuplicatesViaFilter(ColumnRangeOfDuplicates As Range) As Long

The ColumnRangeOfDuplicates specifies the range that is to be stripped of duplicate records.  This range should span all the rows that are to be tested for duplicates, and should span the contiguous columns that are used as the test for duplicates. For example to delete duplicates records from rows 11 to 25, using columns B and C as the test columns, you would pass the range B11:C25 as ColumnRangeOfDuplicates. Note that the columns in ColumnRangeOfDuplicates must be contiguous. If ColumnRangeOfDuplicates has more than one Area, an error will occur.

For speed of execution, the code builds a range of rows to be deleted, and then does one delete operation rather than deleting one row at a time. Also, it saves the EnableEvents, Calculation, and ScreenUpdating properties, turns them to False, and then later restores them.

The function returns the number of rows deleted, including 0 if no duplicates were found, or -1 if an error occurred, such as a ColumnRangeOfDuplicates  range with more than one area or a range on a protected sheet.

You can download a bas module file containing the function here.
 

 
 
Function DeleteDuplicatesViaFilter(ColumnRangeOfDuplicates As Range) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicatesViaFilter
' This function uses Advanced Filter to remove duplicate records from
' the rows spanned by ColumnRangeOfDuplicates. A row is considered to
' be a duplicate of another row if the columns spanned by ColumnRangeOfDuplictes
' are equal. Columns outside of those spanned by ColumnRangeOfDuplicates
' are not tested.  The function returns the number of rows deleted, including
' 0 if there were no duplicates, or -1 if an error occurred, such as a
' protected sheet or a ColumnRangeOfDuplicates range with multiple areas.
' Note that Advanced Filter considers the first row to be the header row
' of the data, so it will never be deleted.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim DeleteRange As Range
Dim Rng As Range
Dim SaveCalc As Long
Dim SaveEvents As Long
Dim SaveUpdating As Long
Dim BeginRowCount As Long
Dim EndRowCount As Long

''''''''''''''''''''''''''''
' Save application settings.
''''''''''''''''''''''''''''
SaveCalc = Application.Calculation
SaveEvents = Application.EnableEvents
SaveUpdating = Application.ScreenUpdating

On Error GoTo ErrH:

'''''''''''''''''''''''''''''''''
' Allow only one area.
'''''''''''''''''''''''''''''''''
If ColumnRangeOfDuplicates.Areas.Count > 1 Then
    DeleteDuplicatesViaFilter = -1
    Exit Function
End If

If ColumnRangeOfDuplicates.Worksheet.ProtectContents = True Then
    DeleteDuplicatesViaFilter = -1
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''
' Change application settings for speed.
''''''''''''''''''''''''''''''''''''''''
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
BeginRowCount = ColumnRangeOfDuplicates.Rows.Count

'''''''''''''''''''''''
' AutoFilter the range.
'''''''''''''''''''''''
ColumnRangeOfDuplicates.AdvancedFilter action:=xlFilterInPlace, unique:=True
'''''''''''''''''''''''''''''''''''''''
' Loop through and build a range of
' hidden rows.
'''''''''''''''''''''''''''''''''''''''
For Each Rng In ColumnRangeOfDuplicates
    If Rng.EntireRow.Hidden = True Then
        If DeleteRange Is Nothing Then
            Set DeleteRange = Rng.EntireRow
        Else
            Set DeleteRange = Application.Union(DeleteRange, Rng.EntireRow)
        End If
    End If
Next Rng
'''''''''''''''''''''''''
' Delete the hidden rows.
'''''''''''''''''''''''''
DeleteRange.Delete shift:=xlUp
'''''''''''''''''''''''''
' Turn off the filter.
'''''''''''''''''''''''''
ActiveSheet.ShowAllData
EndRowCount = ColumnRangeOfDuplicates.Rows.Count
'''''''''''''''''''''''''
' Set the return value.
'''''''''''''''''''''''''
DeleteDuplicatesViaFilter = BeginRowCount - EndRowCount

ErrH:
If Err.Number <> 0 Then
    DeleteDuplicatesViaFilter = -1
End If
''''''''''''''''''''''''''''''''''''''
' Restore application settings.
''''''''''''''''''''''''''''''''''''''
Application.Calculation = SaveCalc
Application.EnableEvents = SaveEvents
Application.ScreenUpdating = SaveUpdating

End Function
 
 
     
[IncludeBorders/bottom.htm]