Problems running a dedupe macro...stumped

[thecoffeeguy]

Hello everyone!

Im having trouble running a dedupe macro that I found on this board. Here is the macro I am using:

Option Explicit

Sub Column_Sort_DeleteDuplicates_()
    '   Code by 
    Dim col%, c%, x%, rng As Range
    col = 4  '1 is the column number to search - change it as required
    '   I.E. Column A = 1, Column B = 2, etc

    '   Set the column number of the column to store temporary formula
    c = Range([G1], ActiveSheet.UsedRange).Columns.Count + 1
    '   Exit if the used columns=256 (instead of exiting, could amend thecode _to look for a column containing no data to use for the temporaryformula)
    If c > 256 Then Exit Sub
    '   Set the column offset(from the search column to the temp. formulacolumn)
    x = col - c

    '   Turn off screen-updating and set calculation to manual _
    (if required, could add a test to check if calculation is already set _
    to manual, in which case would not want to set to automatic at the end
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    '   Set the range to contain the temp. formula
        Set rng = Range(Cells(1, c), Cells(65536, col).End(xlUp).Offset(, -x))
        With rng
    '   Sort the data by the search column
            .EntireRow.Sort Key1:=rng(1, x + 1), Order1:=xlAscending, Header:=xlNo
    '   Put temp. value in the fors cell of the temp.column
            rng(1) = 1
    '   Enter the temp formula that identifies duplicates
            .Offset(1).FormulaR1C1 = "=IF(RC[" & x & "]=R[-1]C[" & x & "],"""",1)"
    '   Convert the formula to value
            .Offset(1) = .Offset(1).Value
    '   Sort entire rows by the temp. formula result so as to group all of_the rows to be deleted at the end
            .EntireRow.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlNo
    '   Error handler in case there are no duplicates
           On Error Resume Next
    '   Delete the duplicate rows
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    '   Reset error handling
            On Error GoTo 0
        End With
    '   Delete the temp. formula column
        Columns(c).Delete
    '   Reset the sheet's last used cell
        ActiveSheet.UsedRange
    '   Turn on screen-updating and set calculation to automatic
        .ScreenUpdating = False
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Im running this against a spreadsheet that has 6 columns, and about 22000 rows. I am deduping based on phone numbers that are entered in the spreadsheet as follows:

123-123-1234

Now, in the macro, I changed the column to be checked to the column the phone numbers are in, which is D and I set it to 4. I also get the column to temporary hold the formula to G, as the last column in the sheet is F.

Everytime I run the macro, nothing happens and im stumped.

Anyone have any ideas?

I appreciate it.

thecoffeeguy

 

[Von Pookie]

Well, it's possible that there are no duplicates in the column, and nothing is happening because there's nothing to delete...

There's another way to go about this, though. It's the same basic idea, but it utilizes the advanced filter to filter out the unique data --any rows containing duplicates are hidden and the visible rows are the unique results.

Sub test()
Dim NumRng As Range, ChkRng As Range

'range of phone numbers (assuming D1 is a column header and data starts in D2)
Set NumRng = Range("D1", Range("D65536").End(xlUp))

'insert extra column that will be used to mark the duplicates
NumRng.Offset(, 1).EntireColumn.Insert
Set ChkRng = NumRng.Offset(, 1)

'filter column D to show only unique entries
NumRng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

'mark the visible rows with an 'x'
ChkRng.SpecialCells(xlCellTypeVisible).Value = "x"

'remove filter
On Error Resume Next
ActiveSheet.ShowAllData

'delete any rows that do not have an 'x' in column E
ChkRng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'delete the extra column
ChkRng.EntireColumn.Delete

End Sub

However, since this uses the advanced filter, it will take the data in the other columns into consideration as well. For example, say you have 3 entries with a phone number of 123-456-7890, and the data in Columns A:C are exactly the same for 2 out of the 3 entries. In this case, only 1 of the 3 instances of the phone number will be deleted, leaving 2 entries with the same phone number, but different information in A:C.

...I hope I haven't terribly confused you at this point

 

[thecoffeeguy]

Thanks Von Pookie.

I know there are duplicates in that specific column. I just don't know why it is not deduping the doc. I have used this macro with great success in the past. Very odd.

I'll take a look at that code you put in here, and play with a bit.

any ideas why my original macro isn't working? Something I missed?

-thecoffeeguy