Speeding the Remove Duplicate Formula

[sakrams]

Greeting Excel Gurus,

I have been using below macro to clear duplicates. The best part about his macro is that it clear the dupes but does not delete the rows or sorts the data (it only clear the duplicate values with no rearrangement of cells). However, when I run this formula on 200,000+ rows, excel freezes. I have left the computer for one full day to see if excel comes back but with no luck. Wondering if there is a way to speed this macro?

Public Sub ClearDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Long
Dim n As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

n = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If

V = Rng.Cells(R, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
        Rng.Rows(R).Clear
        n = n + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
        Rng.Rows(R).Clear
        n = n + 1
    End If
End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(n)

End Sub

 

[Fluff]

I don't understand how that happens, have you change the code at all?

 

[TedX]

I don't understand how that happens, have you change the code at all?

I do, but can't explain it, I can't copy the code, when I try only a dozen or so lines are copied. I can only now see the original code. I need a fresh version of the code, if you can just copy it again and paste it so I can get a copy please? Also, I just got the code and ran it, and the exact same thing happened, it appeared to work but nothing changed. So just so I don't confuse you further. The original code you did for the start of this post for the other chap, when I run that, it clears out the duplicates exactly as it's meant to. Then you did a new code for me, which was meant to delete the rows with the duplicates, that actually doesn't do anything and I have not touched a single keystroke of the code.

 

[Fluff]

if you can just copy it again and paste it so I can get a copy please?

All you need to do is use the copy icon (top right of the code window) to copy the code from post#7

 

[TedX]

All you need to do is use the copy icon (top right of the code window) to copy the code from post#7

Yes I just did it again, checked the code line by line, ran it and nothing happened at all. The odd thing is, when I run the original code that works 100%, so whatever change you made, which appears to my untrained eye to be:

Rng.Value = Ary
If Not DelRng Is Nothing Then DelRng.EntireRow.Delete
EndMacro:

Just doesn't seem to be working. It's as if it wants to delete the rows but can't. Go figure

 

[Fluff]

If you put a break point on this line

If Not DelRng Is Nothing Then DelRng.EntireRow.Delete

and run the code to there, then use F8 to step through, does it go to the Then portion?

 

[TedX]

If you put a break point on this line

If Not DelRng Is Nothing Then DelRng.EntireRow.Delete

and run the code to there, then use F8 to step through, does it go to the Then portion?

Nope, it went straight through to the next line. Actually I just redid it and it did go to the next part, the 'Then' part because before when it ran the first half of the line was in yellow, then when I stepped through, it changed to dark red, for the entire line, then I stepped through a second time and it went to what you can see in the image.

 

[Fluff]

If the DelRng.EntireRow.Delete part was never highlighted in yellow it means that there were no duplicates, in which case the message box would have said 0 rows deleted.

 

[TedX]

If the DelRng.EntireRow.Delete part was never highlighted in yellow it means that there were no duplicates, in which case the message box would have said 0 rows deleted.

Okay, I did it mouse click by mouse click and recorded each image, so here is #1 image, showing the breakpoint being hit.

Then the #2 image, where it changes colours:

Then the #3 image, when it falls through to the next line of code:

Then the #4 image, which shows the MsgBox, however as you can see, the Pink duplicates are still there, with a very large number, which should be 300:

I hope you don't get bored with me, but I am doing exactly everything you are suggesting. I know the duplicates are real because if I run the original script, just the names in the selected column are deleted correctly. That wouldn't be so bad, if I could have a different macrow that found blank cells and then deleted the entire row, like what is supposed to happen in the one we are working on now, but it just doesn't seem to want to play ball.

 

[Fluff]

You will get the large number because you have blank cells in the used range.
Do you get any error messages?

 

[TedX]

You will get the large number because you have blank cells in the used range.
Do you get any error messages?

No error messages, it appears to work perfectly, except it doesn't actually delete the rows. Under what conditions would Excel decide to disobey a direct order?