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 |
||