Code
Sub DeleteDuplicateRows()
Dim lr As Long, lc As Long, i As Long
Dim x, dict
Dim str As String
Dim delRng As Range
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To lr
lc = Cells(i, Columns.Count).End(xlToLeft).Column
x = Range("A" & i, Cells(i, lc)).Value
If IsArray(x) Then
str = Join(Application.Index(x, 1, 0), ",")
Else
str = x
End If
If Not dict.exists(str) Then
dict.Item(str) = ""
Else
If delRng Is Nothing Then
Set delRng = Cells(i, 1)
Else
Set delRng = Union(delRng, Cells(i, 1))
End If
End If
Next i
If Not delRng Is Nothing Then delRng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Display More
is there anyway to make this code somewhat fast