Dim Counter
Dim i As Integer
Sub Dups()
'
' NOTE: You must select the first cell in the column and
' make sure that the column is sorted before running this macro.
ScreenUpdating = False
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
offsetcount = 1
Do While ActiveCell <> ""
If FirstItem = SecondItem Then
ActiveCell.Offset(offsetcount, 0).Interior.Color = RGB(255, 0, 0)
ActiveCell.Offset(offsetcount - 1, 0).Interior.Color = RGB(255, 0, 0)
offsetcount = offsetcount + 1
SecondItem = ActiveCell.Offset(offsetcount, 0).Value
Else
ActiveCell.Offset(offsetcount, 0).Select
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
offsetcount = 1
End If
Loop
End Sub
|