Revision: 20750
Updated Code
at January 20, 2010 03:17 by a1ias
Updated Code
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
' Uncomment next line to highlight both repeating lines
' ActiveCell.Offset(Offsetcount - 1,0).Interior.Color = RGB(255,0,0)
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
Revision: 20749
Initial Code
Initial URL
Initial Description
Initial Title
Initial Tags
Initial Language
at November 24, 2009 09:46 by a1ias
Initial Code
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
Initial URL
http://support.microsoft.com/kb/213355
Initial Description
Initial Title
Find duplicate cells in excel column
Initial Tags
excel
Initial Language
Visual Basic