Search code examples
excelduplicatesformattingconditional-statementshighlight

Highlight cells with duplicate values, but each duplicate value a unique color. Excel Conditional Formatting


Basically I'd like to highlight all duplicate cells with duplicate values. I've used conditional formatting to do this. The twist is, I would like each different, duplicate value to be highlighted a unique color.

For example, If apple was found in three different cells, highlight them all red. If orange was found in two different cells, high them all blue etc. etc. and this will go on for hundreds of different, duplicate values... So I need it to generate slightly unique colors as well.

Any ideas? Thanks!

EDIT: I found a solution at this website: https://www.extendoffice.com/documents/excel/3772-excel-highlight-duplicate-values-in-different-colors.html although it costs money to install, this module, so if anyone has a different solution it would be greatly appreciated.


Solution

  • I found a solution that uses KUTOOlS which can be found at the following website: https://www.extendoffice.com/documents/excel/3772-excel-highlight-duplicate-values-in-different-colors.html

    Insert a module in VBA and enter the following code:

    Sub ColorCompanyDuplicates()
    'Updateby Extendoffice 20160704
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
      End Sub
    

    Then press F5 to run the module.

    (NOTE: This only works with KUTOOLS installed)