Highlight duplicates within the same cell

[YasserKhalil]

Hello everyone

I am trying the following code so as to highlight the duplicates in the same cell

Code: Select all

Sub Highlight_Duplicates_Within_Cell()
    Dim s       As Variant
    Dim sp      As Variant
    Dim k       As Variant
    Dim c     As Range
    Dim dn      As Range
    Dim n       As Long

        Set c = Range("A1")
        c.Font.Color = vbBlack
        With CreateObject("Scripting.Dictionary")
            .CompareMode = vbTextCompare
            For Each dn In c
                sp = Split(dn.Value, ",")
                For Each s In sp
                    If Not .Exists(s) Then
                        .Add s, 1
                    Else
                        .Item(s) = .Item(s) + 1
                    End If
                Next s
            Next dn
Dim t As String
            For Each dn In c
                For Each k In .Keys
                    t = k & ","
                    n = 1
                    Do While InStr(n, dn.Value, t, vbTextCompare) And .Item(k) > 1
                        dn.Characters(InStr(n, dn.Value, t, vbTextCompare), Len(t)).Font.Color = vbRed
                        n = n + Len(k)
                    Loop
                Next k
            Next dn
        End With
End Sub

Say in A1 = 2,4,6,8,12,14,18,23,35,78,101,38,30,205,2,101
The duplicate values are 2 and 101
How can I achieve that.. I tried but the result is not totally correct

[HansV]

Try this version:

Code: Select all

Sub Highlight_Duplicates_Within_Cell()
    Dim s       As Variant
    Dim sp      As Variant
    Dim k       As Variant
    Dim c     As Range
    Dim dn      As Range
    Dim n       As Long
    Dim t As String

    Set c = Range("A1")
    c.Font.Color = vbBlack
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each dn In c
            sp = Split(dn.Value, ",")
            For Each s In sp
                If Not .Exists(s) Then
                    .Add s, 1
                Else
                    .Item(s) = .Item(s) + 1
                End If
            Next s
        Next dn
        For Each dn In c
            For Each k In .Keys
                t = "," & k & ","
                n = 1
                Do While InStr(n, "," & dn.Value & ",", t, vbTextCompare) And .Item(k) > 1
                    dn.Characters(InStr(n, "," & dn.Value & ",", t, vbTextCompare), Len(t) - 2).Font.Color = vbRed
                    n = n + Len(k)
                Loop
            Next k
        Next dn
    End With
End Sub

[YasserKhalil]

That's great. Thanks a lot
Is it possible to skip the first instance from highlighting and highlight the rest?
I mean as for the example the 2 and 101 ( the first instance to be skipped) and to color the others.

[HansV]

Code: Select all

Sub Highlight_Duplicates_Within_Cell()
    Dim s       As Variant
    Dim sp      As Variant
    Dim k       As Variant
    Dim c       As Range
    Dim dn      As Range
    Dim n       As Long
    Dim t       As String
    Dim f       As Boolean

    Set c = Range("A1")
    c.Font.Color = vbBlack
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each dn In c
            sp = Split(dn.Value, ",")
            For Each s In sp
                If Not .Exists(s) Then
                    .Add s, 1
                Else
                    .Item(s) = .Item(s) + 1
                End If
            Next s
        Next dn
        For Each dn In c
            For Each k In .Keys
                t = "," & k & ","
                f = False
                n = InStr(1, "," & dn.Value & ",", t, vbTextCompare)
                Do While n And .Item(k) > 1
                    If f Then
                        dn.Characters(n, Len(t) - 2).Font.Color = vbRed
                    End If
                    n = InStr(n + Len(k), "," & dn.Value & ",", t, vbTextCompare)
                    f = True
                Loop
            Next k
        Next dn
    End With
End Sub

[YasserKhalil]

That's amazing. Thank you very much for great help.