S
samangh1 via OfficeKB.com
Hello,
I need to highlight batch of duplicates in different color. For example one
set of dups will be red and next set would be yellow and so on.
I have this macro but it highlights every dups with diffrent color.
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.ColorIndex = Int(Rnd(1) *
21) + 2
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
Any help?
Thx.
I need to highlight batch of duplicates in different color. For example one
set of dups will be red and next set would be yellow and so on.
I have this macro but it highlights every dups with diffrent color.
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.ColorIndex = Int(Rnd(1) *
21) + 2
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
Any help?
Thx.