Duplicate color change

[wcmash]

I have the following code to find duplicates and change the color of the cell in Excel. Is there a way to alternate between 2 colors with every set of duplicates that way i can see each set easily.

Sub Highlight_Duplicates(Values As Range)
Dim Cell

For Each Cell In Values
If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
Cell.Interior.ColorIndex = 6


End If
Next Cell




End Sub

 

[Andrzejek]

I would try something like:

Sub Highlight_Duplicates(Values As Range)
Dim Cell [red]As What?[/red][blue]
Static blnColor As Boolean[/blue]

For Each Cell In Values
    If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
        [blue]If blnColor Then[/blue]
            Cell.Interior.ColorIndex = 6[blue]
        Else
            Cell.Interior.ColorIndex = 2
        End If
              
        blnColor = Not(blnColor)[/blue]
    End If
Next Cell
    
End Sub

Code not tested.

Have fun.

---- Andy

 

[glenntb]

If you want to highlight the pairs of duplicates, you'll need to modify the above code to something along these lines:

Sub Highlight_Duplicates(Values As Range)

Static blnColor As Boolean
'
' Make sure there's no highlighting already in our range:
    Values.Interior.ColorIndex = xlColorIndexNone

For Each Cell In Values.Cells
    '
    ' If we're on an un-highlighted cell...
    If Cell.Interior.ColorIndex = xlColorIndexNone Then
        '
        ' ...see if it is unique or if it has any duplicates:
        If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
            '
            ' Toggle between the two colors:
            If blnColor Then
                Application.ReplaceFormat.Interior.ColorIndex = 6
            Else
                Application.ReplaceFormat.Interior.ColorIndex = 7
            End If
            '
            ' Highlight all duplicate cells:
            Cells.Replace What:=Cell.Value, Replacement:=Cell.Value, LookAt:=xlPart, SearchOrder _
                :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
            
            blnColor = Not (blnColor)
            
        End If
    Else
    '
    ' ...Else we're on a cell that has already been highlighted;
    ' we already know it's a duplicate so do nothing else to it.
    
    End If
    
Next Cell
    
End Sub

-Glenn
(note: I will be away from my computer next week (vacation) so won't be available for awhile to answer any follow-up questions you may have. Sorry.)

 

[Gavona]

There is a better way of seeing each set easily. If there are several duplicates in a long list then simple highlighting may not help with your next step. Instead/as well you could use a helper column.

This adaptation of Glenn's code exemplifies the approach and assumes your range is in a single column.

Sub Highlight_Duplicates(Values As Range)

Static blnColor As Boolean
Dim i As Integer
Dim strS As String

With Values
    ' Make sure there's no highlighting already in our range:
    .Interior.ColorIndex = xlColorIndexNone
    'create a helper column
    .EntireColumn.Insert
    .Copy Destination:=.Offset(0, -1)
End With
For Each Cell In Values.Cells
    '
    ' If we're on an un-highlighted cell...
    If Cell.Interior.ColorIndex = xlColorIndexNone Then
        '
        ' ...see if it is unique or if it has any duplicates:
        If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
            '
            ' Toggle between the two colors:
            If blnColor Then
                Application.ReplaceFormat.Interior.ColorIndex = 6
            Else
                Application.ReplaceFormat.Interior.ColorIndex = 7
            End If
            '
            ' Highlight all duplicate cells:
            Cells.Replace What:=Cell.Value, Replacement:=Cell.Value, LookAt:=xlWhole, SearchOrder _
                :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
            i = i + 1
            Values.Offset(0, -1).Replace What:=Cell.Value, Replacement:="Duplicates set: " & i, LookAt:=xlWhole, SearchOrder _
                :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
            blnColor = Not (blnColor)
        Else
            'Cell is not duplicated
            Cell.Offset(0, -1).Value = ""
        End If
    Else
    '
    ' ...Else we're on a cell that has already been highlighted;
    ' we already know it's a duplicate so do nothing else to it.
    
    End If
    
Next Cell
    
End Sub

Gavin

 

[wcmash]

Thanks for the responses I have been out of the office sorry for the delay. This is always going to be column C what is the best way to make the code run. Sorry for the stupid questions.

 

[SkipVought]

You do have a good solution from Andy.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[wcmash]

I tried that code and it did not so what I wanted it to do. I had a Macro that set the range name and made this highlight_duplicates run but i deleted it accidently and can't remember how i had it working.

 

[SkipVought]

Turn on your macro recorder and name the range. Then observe your code!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]