Deleting Duplicate Rows With Advanced Filter

This page describes how to use the Advanced Filter tool to delete duplicate rows.

Introduction

You can use Excel's Advanced Filter tool to delete duplicate rows in a range of data. The function shown below, DeleteDuplicatesViaFilter, will delete entire rows leaving distinct rows of data. You pass to the function the range to test for duplicates and the function returns as its result the number of rows deleted, or -1 if an error occurred.

The range that you pass into the function should contain all the rows you want to test for duplicates, and contain (only) the columns that are used to determine whether a row is a duplicate. For example, if your data is in rows 1 to 100 and columns D and E together contain the data that determines whether a row is a duplicate, you would pass in the range D1:E100. Note that even though the input range is 1 or more columns, entire rows are deleted. The range that you pass to the function must be contiguous. That is, the columns that determine whether a row is a duplicate must be adjacent. The function will fail if the input range has more than one area.

Although this procedured is a Function, you cannot call it from a worksheet cell. It is intended to be called from other VBA procedures. You can use the Sub version of this procedure, callable from the Macros dialog on the Tools menu, to filter out duplicates by selecting the range to filter and then executing the Sub procedure. The downloadable module contains both the Sub and the Function version of the procedure.

Excel's Filter function assumes that the first row of the input range is comprised of column titles, so the first row will never be deleted and may cause a single duplicate row to be included in the result.

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

The Code For The Function And Sub Procedures

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

The code for the Sub version is shown below.

Sub DeleteDuplicatesViaFilterSub()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicatesViaFilterSub
' This function uses Advanced Filter to remove duplicate records from
' the rows spanned by the Selection. 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. Note that Advanced Filter considers the first row to be
' the header row of the data, so it will never be deleted.
'
' To use this procedure, select the entire range of data to be filtered,
' including the header row, and the run the procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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:

'''''''''''''''''''''''''''''''''
' Ensure the selection object is
' a Range.
'''''''''''''''''''''''''''''''''
If Not TypeOf Selection Is Range Then
    Exit Sub
End If

'''''''''''''''''''''''''''''''''
' Allow only one area.
'''''''''''''''''''''''''''''''''
If Selection.Areas.Count > 1 Then
    Exit Sub
End If

If Selection.Worksheet.ProtectContents = True Then
    Exit Sub
End If

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

'''''''''''''''''''''''
' AutoFilter the range.
'''''''''''''''''''''''
Selection.AdvancedFilter action:=xlFilterInPlace, unique:=True
'''''''''''''''''''''''''''''''''''''''
' Loop through and build a range of
' hidden rows.
'''''''''''''''''''''''''''''''''''''''
For Each Rng In Selection
    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


ErrH:
''''''''''''''''''''''''''''''''''''''
' Restore application settings.
''''''''''''''''''''''''''''''''''''''
Application.Calculation = SaveCalc
Application.EnableEvents = SaveEvents
Application.ScreenUpdating = SaveUpdating

End Sub

This page last updated: 1-December-2007