Article ID: 142591
Article Last Modified on 10/11/2006
Sub FindDups ()
'
' 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)
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
ScreenUpdating = True
End Sub
Additional query words: 5.00c 8.00 xl97 double repeat XL
Keywords: kbdtacode kbhowto kbprogramming KB142591