How to compare delimited values regardless of order

dougebowl · Sep 13, 2021

I need to compare delimited values in two columns to determine if the values all the values are present in the adjacent cell for each row.

The two columns are not static, so I need to be able to select the columns to compare
Values in either column could be duplicated in a single cell, so looking to insure each value in the cell is contained in the adjacent cell
Values could appear in different order, so a simple match formula does not work
For value(s) in the cell that are not found in the adjacent cell, I would like the font color to be "Red"
Comparison should look column 1 compared to column 2 and column 2 compared to column 1 to display the differences
Values will always be semi-colon ";" delimited

I hope this ask is fairly straight forward and clear. I do so appreciate the assistance.

Eric W · Sep 13, 2021

This is the kind of question that would benefit greatly from some sample data, not just an explanation. Here's what I came up with:

Book1 (version 1).xlsb

A

B

C

D

E

F

1

List1

List3

List1

List2

List3

List4

2

cat;dog

hen;cat

dog;banana

hen;turtle

3

mouse;lizard

dog;mouse

mouse;house

dog;mouse

4

pig;hen

peach;cat

lizard;mouse

house;mouse

5

turtle;banana

banana;peach

lizard;turtle

6

hen;cat

7

Sheet8

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C:F	Expression	=AND(ROW()>1,C1<>"",OR(COUNTIF(INDEX($C$2:$F$20,0,MATCH(INDEX($A$1:$B$1,3-MATCH(C$1,$A$1:$B$1,0)),$C$1:$F$1,0)),""&LEFT(C1,FIND(";",C1)-1)&"")=0,(COUNTIF(INDEX($C$2:$F$20,0,MATCH(INDEX($A$1:$B$1,3-MATCH(C$1,$A$1:$B$1,0)),$C$1:$F$1,0)),""&MID(C1,FIND(";",C1)+1,99)&"")=0)))	text	NO

Put the lists you want to compare in A1:B1. This formula is highly dependent on the sheet layout, but might be improved with an example.

JGordon11 · Sep 13, 2021

VBA Code:

Sub ColorRedNonMatch()  'Select two column range to compare columns with semicolon delimited data, limited to 25 non-matched items per cell
    Dim A, Rng As Range, uba As Long, i As Long, j As Long, item1, item2, k As Long, lencount As Long, found As Boolean
    Set Rng = Application.InputBox("Select Range", Default:=Selection.Address, Type:=8)
    A = Rng
    uba = UBound(A)
    ReDim B(1 To uba, 1 To 51)
    ReDim C(1 To uba, 1 To 51)
    For i = 1 To uba
        For j = 1 To 2
            A(i, j) = Split(A(i, j), ";")
        Next
        
        k = 2
        lencount = 0
        For Each item1 In A(i, 1)
            found = False
            For Each item2 In A(i, 2)
                If item1 = item2 Then
                    found = True
                    lencount = lencount + Len(item1) + 1
                    Exit For
                End If
            Next
            If Not found Then
                B(i, 1) = B(i, 1) + 1
                B(i, k) = lencount + 1
                B(i, k + 1) = Len(item1)
                lencount = lencount + Len(item1) + 1
                k = k + 2
            End If
        Next
    Next
    
    For i = 1 To uba
        k = 2
        lencount = 0
        For Each item1 In A(i, 2)
            found = False
            For Each item2 In A(i, 1)
                If item1 = item2 Then
                    found = True
                    lencount = lencount + Len(item1) + 1
                    Exit For
                End If
            Next
            If Not found Then
                C(i, 1) = C(i, 1) + 1
                C(i, k) = lencount + 1
                C(i, k + 1) = Len(item1)
                lencount = lencount + Len(item1) + 1
                k = k + 2
            End If
        Next
    Next
    
    For i = 1 To uba
        For j = 1 To B(i, 1)
            Rng(i, 1).Characters(Start:=B(i, j * 2), Length:=B(i, j * 2 + 1)).Font.Color = -16776961
        Next
        For j = 1 To C(i, 1)
            Rng(i, 2).Characters(Start:=C(i, j * 2), Length:=C(i, j * 2 + 1)).Font.Color = -16776961
        Next
    Next

End Sub

dougebowl · Sep 14, 2021

JGordon11 said:

View attachment 46825

VBA Code:

Sub ColorRedNonMatch()  'Select two column range to compare columns with semicolon delimited data, limited to 25 non-matched items per cell
    Dim A, Rng As Range, uba As Long, i As Long, j As Long, item1, item2, k As Long, lencount As Long, found As Boolean
    Set Rng = Application.InputBox("Select Range", Default:=Selection.Address, Type:=8)
    A = Rng
    uba = UBound(A)
    ReDim B(1 To uba, 1 To 51)
    ReDim C(1 To uba, 1 To 51)
    For i = 1 To uba
        For j = 1 To 2
            A(i, j) = Split(A(i, j), ";")
        Next
       
        k = 2
        lencount = 0
        For Each item1 In A(i, 1)
            found = False
            For Each item2 In A(i, 2)
                If item1 = item2 Then
                    found = True
                    lencount = lencount + Len(item1) + 1
                    Exit For
                End If
            Next
            If Not found Then
                B(i, 1) = B(i, 1) + 1
                B(i, k) = lencount + 1
                B(i, k + 1) = Len(item1)
                lencount = lencount + Len(item1) + 1
                k = k + 2
            End If
        Next
    Next
   
    For i = 1 To uba
        k = 2
        lencount = 0
        For Each item1 In A(i, 2)
            found = False
            For Each item2 In A(i, 1)
                If item1 = item2 Then
                    found = True
                    lencount = lencount + Len(item1) + 1
                    Exit For
                End If
            Next
            If Not found Then
                C(i, 1) = C(i, 1) + 1
                C(i, k) = lencount + 1
                C(i, k + 1) = Len(item1)
                lencount = lencount + Len(item1) + 1
                k = k + 2
            End If
        Next
    Next
   
    For i = 1 To uba
        For j = 1 To B(i, 1)
            Rng(i, 1).Characters(Start:=B(i, j * 2), Length:=B(i, j * 2 + 1)).Font.Color = -16776961
        Next
        For j = 1 To C(i, 1)
            Rng(i, 2).Characters(Start:=C(i, j * 2), Length:=C(i, j * 2 + 1)).Font.Color = -16776961
        Next
    Next

End Sub

JGordon, this is exactly what I was looking for. THANK you so much, you have saved me hours of manually comparing columns of data.

JGordon11 · Sep 14, 2021

Glad it's working for you. Thanks for the feedback.

dougebowl · Oct 1, 2021

I ran into an issue where I have more than 25 values needing to be matched. The comparison does not execute for these. Is there a way to modify this so there is no limitation to the number of values?

Rick Rothstein · Oct 1, 2021

Although I used the same setup as JGordon11 did, this macro uses a completely different (much more compact) approach than he used. And while I did not test for it, I see no reason it should have any size limitations. See if it works for you...

VBA Code:

Sub HighlightUniques()
  Dim Cell As Range, V As Variant, Acol As Variant, Bcol As Variant
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Cell.Font.Color = vbBlack
    Cell.Offset(, 1).Font.Color = vbBlack
    Acol = Split(Cell.Value, ";")
    Bcol = Split(Cell.Offset(, 1).Value, ";")
    For Each V In Acol
      If UBound(Filter(Bcol, V, True)) = -1 Then Cell.Characters(InStr(";" & Cell.Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
    For Each V In Bcol
      If UBound(Filter(Acol, V, True)) = -1 Then Cell.Offset(, 1).Characters(InStr(";" & Cell.Offset(, 1).Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
  Next
End Sub

JGordon11 · Oct 1, 2021

Rick Rothstein said:

Although I used the same setup as JGordon11 did, this macro uses a completely different (much more compact) approach than he used. And while I did not test for it, I see no reason it should have any size limitations. See if it works for you...

VBA Code:

Sub HighlightUniques()
  Dim Cell As Range, V As Variant, Acol As Variant, Bcol As Variant
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Cell.Font.Color = vbBlack
    Cell.Offset(, 1).Font.Color = vbBlack
    Acol = Split(Cell.Value, ";")
    Bcol = Split(Cell.Offset(, 1).Value, ";")
    For Each V In Acol
      If UBound(Filter(Bcol, V, True)) = -1 Then Cell.Characters(InStr(";" & Cell.Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
    For Each V In Bcol
      If UBound(Filter(Acol, V, True)) = -1 Then Cell.Offset(, 1).Characters(InStr(";" & Cell.Offset(, 1).Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
  Next
End Sub

Thanks for introduction to VBA filter function. First time seeing it and it is quite efficient in this type of application.

dougebowl · Oct 4, 2021

Rick Rothstein said:

Although I used the same setup as JGordon11 did, this macro uses a completely different (much more compact) approach than he used. And while I did not test for it, I see no reason it should have any size limitations. See if it works for you...

VBA Code:

Sub HighlightUniques()
  Dim Cell As Range, V As Variant, Acol As Variant, Bcol As Variant
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Cell.Font.Color = vbBlack
    Cell.Offset(, 1).Font.Color = vbBlack
    Acol = Split(Cell.Value, ";")
    Bcol = Split(Cell.Offset(, 1).Value, ";")
    For Each V In Acol
      If UBound(Filter(Bcol, V, True)) = -1 Then Cell.Characters(InStr(";" & Cell.Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
    For Each V In Bcol
      If UBound(Filter(Acol, V, True)) = -1 Then Cell.Offset(, 1).Characters(InStr(";" & Cell.Offset(, 1).Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
  Next
End Sub

This works great. My only question is that it appears that it will compare the values in Columns A and B. Could this be modified so that I may define the columns to be compared. The two columns I need to compare are dynamic and do not always appear in the same columns for different worksheets. The solution JGordon11 provided allowed me to select the range I need to compare.

Rick Rothstein · Oct 4, 2021

Try this version of my code then... it will ask you to type in the two column designations (letters or numbers) with a comma between them.

**** SEE MESSAGE #12 FOR CORRECTED CODE ****

Rich (BB code):

Sub HighlightUniques()
  Dim Col1 As String, Col2 As String, ColsIn As String
  Dim Cell As Range, V As Variant, Acol As Variant, Bcol As Variant
  ColsIn = InputBox("Type the letter or number designation for the two columns with a comma between them.")
  If (Not ColsIn Like "*?,?*") Or (ColsIn Like "*,*,*") Then Exit Sub
  Col1 = Left(ColsIn, InStr(ColsIn, ",") - 1)
  Col2 = Mid(ColsIn, InStr(ColsIn, ",") + 1)
  For Each Cell In Range(Cells(1, Col1), Cells(Rows.Count, Col1).End(xlUp))
    Cell.Font.Color = vbBlack
    Cells(Cell.Row, Col2).Font.Color = vbBlack
    Acol = Split(Cell.Value, ";")
    Bcol = Split(Cells(Cell.Row, Col2).Value, ";")
    For Each V In Acol
      If UBound(Filter(Bcol, V, True)) = -1 Then Cell.Characters(InStr(";" & Cell.Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
    For Each V In Bcol
      If UBound(Filter(Acol, V, True)) = -1 Then Cells(Cell.Row, Col2).Characters(InStr(";" & Cells(Cell.Row, Col2).Value & ";", ";" & V & ";"), Len(V)).Font.Color = vbRed
    Next
  Next
End Sub

How to compare delimited values regardless of order

dougebowl

Board Regular

Excel Facts

Eric W

MrExcel MVP

JGordon11

Well-known Member

dougebowl

Board Regular

JGordon11

Well-known Member

dougebowl

Board Regular

Rick Rothstein

MrExcel MVP

JGordon11

Well-known Member

dougebowl

Board Regular

Rick Rothstein

MrExcel MVP

Similar threads

Forum statistics

Share this page

How to compare delimited values regardless of order

Board Regular

Excel Facts

MrExcel MVP

Well-known Member

Board Regular

Well-known Member

Board Regular

MrExcel MVP

Well-known Member

Board Regular

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock