Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Chip Pearson's NewWorkDays formula | Excel Discussion (Misc queries) | |||
How to Use Chip Pearson's Text Import Code | Excel Programming | |||
Chip Pearson's Forum Etiquette | New Users to Excel | |||
Pearson's Progress Bar | Excel Discussion (Misc queries) | |||
Help with Chip Pearson's Code for Deleting Blank Rows | Excel Programming |