sakrams
Board Regular
- Joined
- Sep 28, 2009
- Messages
- 59
- Office Version
- 2016
- Platform
- Windows
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?
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?
VBA Code:
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