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