How to compare delimited values regardless of order

[dougebowl]

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.

1. The two columns are not static, so I need to be able to select the columns to compare
2. 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
3. Values could appear in different order, so a simple match formula does not work
4. For value(s) in the cell that are not found in the adjacent cell, I would like the font color to be "Red"
5. Comparison should look column 1 compared to column 2 and column 2 compared to column 1 to display the differences
6. Values will always be semi-colon ";" delimited

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

 

[RoryA]

Worth noting that Filter will match anything that contains the filter value. So 'b' on one side would not be flagged if 'bb' is on the other (but the 'bb' would be flagged).

 

[Rick Rothstein]

Thanks for noting that Rory! I thought I was handling that problem with the way I handled the InStr function arguments inside the Characters property, but as you pointed out, it only works in one direction. I have changed my code to eliminate the Filter function in favor of a different method of identifying the non-matched items.

Sub HighlightUniques()
  Dim Pos As Long, 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
      Pos = InStr(";" & Cells(Cell.Row, Col2).Value & ";", ";" & V & ";")
      If Pos = 0 Then Cell.Characters(InStr(Cell.Value, V), Len(V)).Font.Color = vbRed
    Next
    For Each V In Bcol
      Pos = InStr(";" & Cell.Value & ";", ";" & V & ";")
      If Pos = 0 Then Cells(Cell.Row, Col2).Characters(InStr(Cells(Cell.Row, Col2), V), Len(V)).Font.Color = vbRed
    Next
  Next
End Sub

 

[dougebowl]

That worked perfectly!! Thank you very much for the support!!

 

[Jaricketts]

Thanks for noting that Rory! I thought I was handling that problem with the way I handled the InStr function arguments inside the Characters property, but as you pointed out, it only works in one direction. I have changed my code to eliminate the Filter function in favor of a different method of identifying the non-matched items.

Sub HighlightUniques()
  Dim Pos As Long, 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
      Pos = InStr(";" & Cells(Cell.Row, Col2).Value & ";", ";" & V & ";")
      If Pos = 0 Then Cell.Characters(InStr(Cell.Value, V), Len(V)).Font.Color = vbRed
    Next
    For Each V In Bcol
      Pos = InStr(";" & Cell.Value & ";", ";" & V & ";")
      If Pos = 0 Then Cells(Cell.Row, Col2).Characters(InStr(Cells(Cell.Row, Col2), V), Len(V)).Font.Color = vbRed
    Next
  Next
End Sub

2 years later and your efforts are still saving lives, lol! Many thanks for this, I had a year-end project that was kicking my butt.