DeleteDuplicatesViaFilter From Chip Pearson's Website
 

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

DeleteDuplicatesViaFilter From Chip Pearson's Website
 

Never Mind Chip let me know that I need to use a function in VB code, not in
a cell.

"JohnHB" wrote:

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