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

I think sorting the data may even make the macro work faster.

But this worked ok when I checked a single column:

Option Explicit
Sub DeleteDupes()
Dim Iloop As Long
Dim Numrows As Long

'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ActiveSheet
Numrows = .Range("A65536").End(xlUp).Row

For Iloop = Numrows To 2 Step -1
If Application.CountIf(.Range("a1:A" & Iloop - 1), _
.Cells(Iloop, "A").Value) 0 Then
'there's at least one duplicate above this row
.Rows(Iloop).Delete
End If
Next Iloop
End With
'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

If I wanted to check a pair of columns (A concatenated with B or A+B (if they're
numeric), then I'd insert a helper column and stick a formula in that cell that
adds them or concatentates them nicely:

=a1+b1
or
=A1&"|"&B1

The vertical bar is used so that
AAA BBB
and
AA ABBB
won't be treated as duplicates.


elfmajesty wrote:

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

--

Dave Peterson