Highlight Words In One Column That Do Not Appear In A Second Column

**Rick Rothstein** · 08-24-2015, 10:46 PM

This has come up several times over the years, the usual request being to simply highlight the words or phrases in Column A that do not appear in Column B. The following code does this by highlighting those words in red. Both lists are assumed to start in Row 1 of their respective columns.

Code:

Sub HighlightWordsOneColumn()
  Dim X As Long, ColA As String
  Dim Words As Variant, vNum As Variant
  Words = Range("B1", Cells(Rows.Count, "B").End(xlUp))
  ColA = Chr(1) & Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), Chr(1) & Chr(1)) & Chr(1)
  For X = 1 To UBound(Words)
    ColA = Replace(ColA, Chr(1) & Words(X, 1) & Chr(1), Chr(1) & Chr(1))
  Next
  For Each vNum In Array(121, 13, 5, 3, 3, 2)
    ColA = Replace(ColA, String(vNum, Chr(1)), Chr(1))
  Next
  Words = Split(Mid(ColA, 2, Len(ColA) - 2), Chr(1))
  With Application
    .ScreenUpdating = False
    .ReplaceFormat.Clear
    .ReplaceFormat.Font.Color = vbRed
    For X = 0 To UBound(Words)
      Columns("A").Replace Words(X), Words(X), ReplaceFormat:=True
    Next
    .ReplaceFormat.Clear
    .ScreenUpdating = True
  End With
End Sub

The last request that I saw for this wanted to highlight both the words in Column A that were not listed in Column B and the words in Column B that were not listed in Column A. Here is the code I posted that does that.

Code:

Sub HighlightWordsTwoColumns()
  Dim X As Long, ColA As String, ColB As String
  Dim Awords As Variant, Bwords As Variant, vNum As Variant
  Awords = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  Bwords = Range("B1", Cells(Rows.Count, "B").End(xlUp))
  ColA = Chr(1) & Join(Application.Transpose(Awords), Chr(1) & Chr(1)) & Chr(1)
  ColB = Chr(1) & Join(Application.Transpose(Bwords), Chr(1) & Chr(1)) & Chr(1)
  For X = 1 To UBound(Awords)
    ColB = Replace(ColB, Chr(1) & Awords(X, 1) & Chr(1), Chr(1) & Chr(1))
  Next
  For X = 1 To UBound(Bwords)
    ColA = Replace(ColA, Chr(1) & Bwords(X, 1) & Chr(1), Chr(1) & Chr(1))
  Next
  For Each vNum In Array(121, 13, 5, 3, 3, 2)
    ColA = Replace(ColA, String(vNum, Chr(1)), Chr(1))
    ColB = Replace(ColB, String(vNum, Chr(1)), Chr(1))
  Next
  Awords = Split(Mid(ColA, 2, Len(ColA) - 2), Chr(1))
  Bwords = Split(Mid(ColB, 2, Len(ColB) - 2), Chr(1))
  With Application
    .ScreenUpdating = False
    .ReplaceFormat.Clear
    .ReplaceFormat.Font.Color = vbRed
    For X = 0 To UBound(Awords)
      Columns("A").Replace Awords(X), Awords(X), ReplaceFormat:=True
    Next
    For X = 0 To UBound(Bwords)
      Columns("B").Replace Bwords(X), Bwords(X), ReplaceFormat:=True
    Next
    .ReplaceFormat.Clear
    .ScreenUpdating = True
  End With
End Sub