Hello,

I want Excel to color duplicates in different color and each set of
duplicates have same color. I found this macro, but it does not highlight the
set of duplicates in same color.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim rng As Range

Set rng = Range("A1:A100")
Application.EnableEvents = False
On Error GoTo sub_exit
If Not Intersect(Target, rng) Is Nothing Then
With Target
For Each cell In rng
If WorksheetFunction.CountIf(rng, cell) 1 Then
cell.Interior.ColorIndex = Int(Rnd(1) * 56) + 1
End If
Next cell
End With
End If
sub_exit:
Application.EnableEvents = True
End Sub



Any Help?

Thx.

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200710/1

Change the one line

cell.Interior.ColorIndex = Int(Rnd(1) * 56) + 1\

to this for red

cell.Interior.ColorIndex = 3


Gord Dibben MS Excel MVP

On Fri, 19 Oct 2007 17:49:57 GMT, "saman110 via OfficeKB.com" <u35670@uwe
wrote:

Hello,

I want Excel to color duplicates in different color and each set of
duplicates have same color. I found this macro, but it does not highlight the
set of duplicates in same color.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim rng As Range

Set rng = Range("A1:A100")
Application.EnableEvents = False
On Error GoTo sub_exit
If Not Intersect(Target, rng) Is Nothing Then
With Target
For Each cell In rng
If WorksheetFunction.CountIf(rng, cell) 1 Then
cell.Interior.ColorIndex = Int(Rnd(1) * 56) + 1
End If
Next cell
End With
End If
sub_exit:
Application.EnableEvents = True
End Sub



Any Help?

Thx.

Ignore this, it will change all cells to red. Not what you wanted.


Gord

On Fri, 19 Oct 2007 15:24:36 -0700, Gord Dibben <gorddibbATshawDOTca wrote:

Change the one line

cell.Interior.ColorIndex = Int(Rnd(1) * 56) + 1\

to this for red

cell.Interior.ColorIndex = 3


Gord Dibben MS Excel MVP

On Fri, 19 Oct 2007 17:49:57 GMT, "saman110 via OfficeKB.com" <u35670@uwe
wrote:

Hello,

I want Excel to color duplicates in different color and each set of
duplicates have same color. I found this macro, but it does not highlight the
set of duplicates in same color.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim rng As Range

Set rng = Range("A1:A100")
Application.EnableEvents = False
On Error GoTo sub_exit
If Not Intersect(Target, rng) Is Nothing Then
With Target
For Each cell In rng
If WorksheetFunction.CountIf(rng, cell) 1 Then
cell.Interior.ColorIndex = Int(Rnd(1) * 56) + 1
End If
Next cell
End With
End If
sub_exit:
Application.EnableEvents = True
End Sub



Any Help?

Thx.