# Problems running a dedupe macro...stumped

#### thecoffeeguy

##### New Member
Hello everyone!

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

Code:
``````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
'   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

### Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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.

Code:
``````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

'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

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

Replies
8
Views
528
Replies
26
Views
548
Replies
1
Views
173
Replies
2
Views
130
Replies
0
Views
154

1,207,286
Messages
6,077,533
Members
446,288
Latest member
lihong3210

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back