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

[Rick Rothstein]

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.




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.




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

[jomili]

When I do this column comparison I want a permanent record without interfering with my source data, so put it on another sheet. Also, I don't always want to compare A and B, sometimes it's J and Q or R and X. The macro below does all of that. I'm sure it could be cleaned up, but it's working as is. BTW, "Speedon" and "Speedoff" are twin macros I have to turn off or on screenupdating, calculations, etc.
Sub CompareColumns()
'Excel macro to compare two columns.
'Copies the two columns to a new sheet, into A and B
'Populates column C with unique values in A and not in B
'Populates column D with unique values in B and not in A
'Puts the values found in both A and B in column E.

'This little section of code tells the addresses of each unigue column picked.
Dim rCol1 As Range, rCol2 As Range
If Intersect(Selection, Selection.Cells(1).EntireRow).Count = 2 Then
If Selection.Areas.Count > 1 Then
Set rCol1 = Selection.Areas(1)
Set rCol2 = Selection.Areas(2)
Else
Set rCol1 = Selection.Columns(1)
Set rCol2 = Selection.Columns(2)
End If
Else
MsgBox "This macro requires two and only two columns for comparison.", vbOKOnly + vbCritical, "Wrong Number of Columns Selected"
Exit Sub
End If

SpeedOn
Dim ws As Worksheet

On Error GoTo LetsQuit
For Each ws In Worksheets
If ws.Name = "Comparison" Then
Application.DisplayAlerts = False
ws.Name = "old_Comparison"
Application.DisplayAlerts = True
End If
Next
On Error Resume Next

Worksheets.Add().Name = "Comparison"
rCol1.Copy Destination:=ActiveSheet.Range("A1")
rCol2.Copy Destination:=ActiveSheet.Range("B1")

Rows(1).Insert
Range("A1:E1").Value = Array("Col " & rCol1.Address, "Col " & rCol2.Address, _
"In " & rCol1.Address & ", not in " & rCol2.Address, _
"In " & rCol2.Address & ", not in " & rCol1.Address, "In both Columns")
Dim d As Object, na&, nb&, a, b
Dim e, p&, q&, r&, m
Set d = CreateObject("scripting.dictionary")

na = Range("A" & Rows.Count).End(3).row
a = Range("A2:A" & na)
nb = Range("B" & Rows.Count).End(3).row
b = Range("B2:B" & nb)
ReDim c(1 To Application.Max(na, nb), 1 To 3)
For Each e In a: d(e) = 1: Next
For Each e In b
If d(e) = 1 Then
r = r + 1
c(r, 3) = e
Else
q = q + 1
c(q, 2) = e
End If
Next
d.RemoveAll
For Each e In b: d(e) = 1: Next
For Each e In a
If d(e) <> 1 Then
p = p + 1
c(p, 1) = e
End If
Next
m = Application.Max(p, q, r)
Range("C2").Resize(m, 3) = c

With Columns("A:E")
.Font.Name = "Arial"
.EntireColumn.AutoFit
End With

With Rows("1:1")
With .Font
.Bold = True
.Name = "Calibri"
.Color = -16776961
.TintAndShade = 0
End With
.HorizontalAlignment = xlCenter
End With
Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
SpeedOff
Exit Sub

LetsQuit:
SpeedOff
MsgBox "Please delete or rename the old_Comparison sheet"
Exit Sub
End Sub

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://eileenslounge.com/viewtopic.php?p=316875#p316875 (https://eileenslounge.com/viewtopic.php?p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316254#p316254 (https://eileenslounge.com/viewtopic.php?p=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316046#p316046 (https://eileenslounge.com/viewtopic.php?p=316046#p316046)
https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050 (https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050)
https://www.youtube.com/@alanelston2330 (https://www.youtube.com/@alanelston2330)
https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z- (https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-)
https://eileenslounge.com/viewtopic.php?p=316154#p316154 (https://eileenslounge.com/viewtopic.php?p=316154#p316154)
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg (https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg)
https://teylyn.com/2017/03/21/dollarsigns/#comment-191 (https://teylyn.com/2017/03/21/dollarsigns/#comment-191)
https://eileenslounge.com/viewtopic.php?p=317050#p317050 (https://eileenslounge.com/viewtopic.php?p=317050#p317050)
https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854 (https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854)
https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875 (https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)