G
Guest
Hello. I found this macro to delete duplicate rows from a spreadsheet, which
works great if the duplicates adjacent to each other. Does anyone know a way
to modify it so that I do not have to sort the spreadsheet first to get the
duplicates to be adjacent? I would love to be able to just run it on an
entire spreadsheet "as-is" and have it pick up the dups and delete them.
Thank you. Macro below:
Sub DeleteDupes()
Dim Iloop As Integer
Dim Numrows As Integer
'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Numrows = Range("A65536").End(xlUp).Row
Range("A1:B" & Numrows).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "A") + Cells(Iloop, "B") = Cells(Iloop - 1, "A") + _
Cells(Iloop - 1, "B") Then
Rows(Iloop).Delete
End If
Next Iloop
'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
works great if the duplicates adjacent to each other. Does anyone know a way
to modify it so that I do not have to sort the spreadsheet first to get the
duplicates to be adjacent? I would love to be able to just run it on an
entire spreadsheet "as-is" and have it pick up the dups and delete them.
Thank you. Macro below:
Sub DeleteDupes()
Dim Iloop As Integer
Dim Numrows As Integer
'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Numrows = Range("A65536").End(xlUp).Row
Range("A1:B" & Numrows).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "A") + Cells(Iloop, "B") = Cells(Iloop - 1, "A") + _
Cells(Iloop - 1, "B") Then
Rows(Iloop).Delete
End If
Next Iloop
'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub