VBA Highlight different duplicates with different colors across a table array-CodePudding

My question is in the title. I have searched up everywhere and this one feels like the only answer that is working:

After some digging, it is probably because of his Find() function that returns Nothing.

My question is why this is the case for my file and not for others. The values there are based on formulas and values of other cells, would that be a problem?

Other approaches are appreciated as well. Thanks!

CodePudding user response：

Since your data contains formulas, you need to set the LookIn parameter to xlValues in the Find method. I updated the original code with these changes, take a look:

Sub Highlight_Duplicate_Entry()
    Dim ws As Worksheet
    Dim cell As Range
    Dim myrng As Range
    Dim clr As Long
    Dim lastCell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set myrng = ws.Range("A2:D" & Range("A" & ws.Rows.Count).End(xlUp).Row)
    With myrng
        Set lastCell = .Cells(.Cells.Count)
    End With
    myrng.Interior.ColorIndex = xlNone
    clr = 3

    For Each cell In myrng
        If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
            ' addresses will match for first instance of value in range
                                    '[================]
            If myrng.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then
                ' set the color for this value (will be used throughout the range)
                cell.Interior.ColorIndex = clr
                clr = clr   1
            Else
                ' if not the first instance, set color to match the first instance
                                                                '[================]
                cell.Interior.ColorIndex = myrng.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
            End If
        End If
    Next
End Sub

CodePudding user response：

A slightly different approach using a Dictionary to track values vs. colors:

Sub Tester()
    ColorDups Range("A1").CurrentRegion
End Sub

Sub ColorDups(rng As Range)
    Dim c As Range, dict As Object, i As Long, v
    Set dict = CreateObject("scripting.dictionary")
    i = 0
    Application.ScreenUpdating = False
    For Each c In rng.Cells
        v = CStr(c.Value)
        If Len(v) > 0 Then
            If Not dict.exists(v) Then
                dict.Add v, c 'store the first cell with this value
            Else
                If TypeOf dict(v) Is Range Then     'second cell with this value?
                    i = i   1                       'next index
                    dict(v).Interior.ColorIndex = i 'color the first cell
                    dict(v) = i                     'store the index
                End If
                c.Interior.ColorIndex = dict(v)     'color this duplicate
            End If
        End If
    Next c
End Sub