VBA Highlight Duplicate comma delimited cells in a column

decadence

Active Member
Joined
Oct 9, 2015
Messages
483
Hi, Is there a way to highlight duplicates in comma delimited cells that are in a column, I want to compare all comma delimited text values in every cell in a column and highlight the cells that contain the duplicate text, Can someone help with this please
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,759
Office Version
2007
Platform
Windows
If you have the data as the following table:

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td > </td><td style="background-color:#00ff00; ">123,abc,123</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td > </td><td >abc,dfg</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td style="background-color:#00ff00; ">ab,ab,cd</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td > </td><td >a,b,c,d</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td > </td><td style="background-color:#00ff00; ">a,b,a,b</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td > </td><td > </td><td > </td></tr></table>
Use the following macro:
Change "B" for the column where your data is

Code:
Sub Highlight_Duplicate()
  Dim c As Range, v As Variant, dict As Object, w As String
  For Each c In Range("[COLOR=#0000ff]B[/COLOR]2", Range("[COLOR=#0000ff]B[/COLOR]" & Rows.Count).End(xlUp))
    Set dict = CreateObject("scripting.dictionary")
    c.Interior.Color = xlNone
    For Each v In Split(c, ",")
      w = Trim(v)
      If Not dict.exists(w) Then
        dict(w) = Empty
      Else
        c.Interior.Color = vbGreen
        Exit For
      End If
    Next
  Next
End Sub
 

decadence

Active Member
Joined
Oct 9, 2015
Messages
483
Hi, The code works great for duplicate text within a cell, however I want to be able to find duplicate comma delimited text in all cells, is this possible?
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,739
Office Version
365
Platform
Windows
The requirement is not clear to me. Some sample data that shows the variety of what you might have and the expected results would help.

As a start, which of these should he highlighted as duplicates. I think all of them are capable of being interpreted to meet your stated requirements but we don't really know what you mean.

A1 & A4 are exact dulplicats
A1, A2 and A4 all contain exactly the same delimited parts (though not all in the same order)
All 4 cells contain the duplicate part "abc"

<b>Excel 2016</b><table cellpadding="2.5px" rules="all" style=";background-color: rgb(255,255,255);border: 1px solid;border-collapse: collapse; border-color: rgb(187,187,187)"><colgroup><col width="25px" style="background-color: rgb(218,231,245)" /><col /></colgroup><thead><tr style=" background-color: rgb(218,231,245);text-align: center;color: rgb(22,17,32)"><th></th><th>A</th></tr></thead><tbody><tr ><td style="color: rgb(22,17,32);text-align: center;">1</td><td style=";">abc,123,def</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">2</td><td style=";">123,def,abc</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">3</td><td style=";">xyz, abc</td></tr><tr ><td style="color: rgb(22,17,32);text-align: center;">4</td><td style=";">abc,123,def</td></tr></tbody></table><p style="width:17.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid rgb(187,187,187);border-top:none;text-align: center;background-color: rgb(218,231,245);color: rgb(22,17,32)">Sheet1</p><br /><br />
 
Last edited:

decadence

Active Member
Joined
Oct 9, 2015
Messages
483
Hi Peter, What I am looking to do is Find All duplicates in all cells of a column, so essentially like your previous post says 'All 4 cells contain the duplicate part "abc"', I would want to find all "abc" text and highlight those cells green and the text ("abc") a different color, lets say purple and "123" and "def" would also be found as duplicates so highlight those words purple too.

The End result would be all 4 cells are highlighted green and all comma delimited text will be purple except "xyz" as it is not duplicate text from those 4 cells
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,739
Office Version
365
Platform
Windows
The End result would be all 4 cells are highlighted green and all comma delimited text will be purple except "xyz" as it is not duplicate text from those 4 cells
Try this in a copy of your workbook.

Rich (BB code):
Sub Dupes()
  Dim d As Object
  Dim a As Variant, itm As Variant
  Dim i As Long, k As Long
  Dim rng As Range
  Dim bColoured As Boolean
  
  Set d = CreateObject("Scripting.Dictionary")
  Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
  a = rng.Value
  For i = 1 To UBound(a)
    For Each itm In Split(a(i, 1), ",")
      d(itm) = d(itm) + 1
    Next itm
  Next i
  Application.ScreenUpdating = False
  For i = 1 To UBound(a)
    k = 1
    bColoured = False
    For Each itm In Split(a(i, 1), ",")
      If d(itm) > 1 Then
        If Not bColoured Then
          rng.Cells(i).Interior.Color = vbGreen
          bColoured = True
        End If
        rng.Cells(i).Characters(k, Len(itm)).Font.Color = RGB(244, 78, 189)
      End If
      k = k + Len(itm) + 1
    Next itm
  Next i
  Application.ScreenUpdating = True
End Sub
 

decadence

Active Member
Joined
Oct 9, 2015
Messages
483
Hi Peter, This works perfectly, Thank you
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,759
Office Version
2007
Platform
Windows
Sorry for the delay, but I also wanted to deliver my version, perhaps with another approach than Peter's macro.

Code:
Sub Highlight_Duplicate()
  Dim b() As Variant, v As Variant, m As Variant
  Dim r As Range, c As Range
  Dim n As Long, i As Long, j As Long, q As Long
  Application.ScreenUpdating = False
  Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
  r.Interior.Color = xlNone
  r.Font.ColorIndex = xlAutomatic
  n = 1
  m = Evaluate("=SUMPRODUCT(LEN(" & r.Address & ")-LEN(SUBSTITUTE(" & r.Address & ","","","""")))")
  ReDim b(1 To (m + r.Rows.Count), 1 To 3)
  For Each c In r
    q = 1
    For Each v In Split(c, ",")
      b(n, 1) = Trim(v)
      b(n, 2) = c.Row
      b(n, 3) = q
      q = q + Len(v) + 1
      n = n + 1
    Next
  Next
  For i = 1 To UBound(b)
    For j = 1 To UBound(b)
      If b(i, 1) = b(j, 1) And b(i, 2) <> b(j, 2) Then
        r.Cells(b(i, 2)).Interior.Color = vbGreen
        r.Cells(b(i, 2)).Characters(InStr(b(i, 3), r.Cells(b(i, 2)), b(i, 1)), Len(b(i, 1))).Font.Color = 12406516
        Exit For
      End If
    Next
  Next
End Sub
 

Forum statistics

Threads
1,077,851
Messages
5,336,759
Members
399,101
Latest member
BharathSanthanam

Some videos you may like

This Week's Hot Topics

Top