Dim cDel As Long
Dim iCtr As Long
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False
' Get count of records to search through.
Dim LstRw As Long
LstRw = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' Loop through records.
For iCtr = LstRw To 2 Step -1
' To specify a different column, change 1 to the column number.
With Sheets("Pivot1").Cells(iCtr, "D") ' Do comparison of "above" record.
If .Value = .Offset(-1, 0).Value Then
' If match is true then delete row.
.EntireRow.Delete 'xlShiftUp
' Increment counter to account for deleted row.
cDel = cDel + 1
End If
End With
'End If
Next iCtr
' Go to next record.
Application.ScreenUpdating = True
MsgBox "Done! " & cDel & " rows deleted"
End Sub
Bookmarks