Hi I got this function below from Chip Pearson's Website
http://www.cpearson.com/
http://www.cpearson.com/excel/DeleteDupsWithFilter.htm
I can't seem to get it to work? I have imported the code into the VB
database and excel recognizes the function, but I keep gettin the -1 error.
I even have tried a simple case like this:
A B C D E F
1 1 3
1 1 2
1 1 2
1 1 1
Now if I put in cell =deleteduplicatesviafilter(a1:c4)
all I have been getting is a -1
Does this function work for anyone else, and if it does can you help me?
Thanks,
John
Option Explicit
Option Compare Text
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
Similar Threads
