Compare word by word between two cells and highlight difference

[Jmac2604]

Hi All,

I have a macro to compare words between cells from column B and D. Currently it is highlighting the matching words in column D. instead I want to highlight the column B. pasted the code below. Can someone pls help me on this?


Sub CompareWords()
Dim xStr() As String
Dim i As Long
Dim x As Long, y As Long

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
xStr = Split(.Cells(i, "B").Value, " ")
With .Cells(i, "D")
.Font.ColorIndex = 1
For x = LBound(xStr()) To UBound(xStr())
For y = 1 To Len(.Text)
If Mid(.Text, y, Len(xStr(x))) = xStr(x) Then

.Characters(y, Len(xStr(x))).Font.ColorIndex = 4

End If
Next y
Next x
End With
Next i
End With
MsgBox "completed"
End Sub

 

[johnmpc]

This should work! I have just swapped the B and D references

Sub CompareWords()
Dim xStr() As String
Dim i As Long
Dim x As Long, y As Long

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
xStr = Split(.Cells(i, "D").Value, " ")
With .Cells(i, "B")
.Font.ColorIndex = 1
For x = LBound(xStr()) To UBound(xStr())
For y = 1 To Len(.Text)
If Mid(.Text, y, Len(xStr(x))) = xStr(x) Then

.Characters(y, Len(xStr(x))).Font.ColorIndex = 4

End If
Next y
Next x
End With
Next i
End With
MsgBox "completed"
End Sub

 

[Jmac2604]

Thanks Johnmpc for your response. I tried this before but actually after swapping the code highlights all the words even though its different. So is it a way to not swap the column and highlight column B (source - words to be checked) and not column D.
Thanks again for your support.

 

[johnmpc]

Thanks Johnmpc for your response. I tried this before but actually after swapping the code highlights all the words even though its different. So is it a way to not swap the column and highlight column B (source - words to be checked) and not column D.
Thanks again for your support.

Did you copy and paste my code in?
I didn't swap the First reference to column B.

 

[Jmac2604]

Did you copy and paste my code in?
I didn't swap the First reference to column B.

Yes I pasted your code and tried. Actually the split should happen in the B column only and it should check the D column and highlight the matching in the B column. Sorry If am confusing you.

 

[johnmpc]

oh, i understand, so you have multiple words in each cell and only want to highlight the matching word in column B.
Does the code work the other way around?

 

[Jmac2604]

oh, i understand, so you have multiple words in each cell and only want to highlight the matching word in column B.
Does the code work the other way around?

Yes correct.

 

[johnmpc]

Yes correct.

Could you post a small example of data please.

 

[Jmac2604]

Rank	Title	Genre	Worldwide gross	Year
	Users/Healthcare professionals should be familiar with surgical procedures and techniques involving non-absorbable sutures before employing Suture for wound closure, as risk of wound dehiscence (In MDR IFU: as risk of tissue separation/wound dehiscence leading to impaired healing )may vary with the site of application and the suture material used		Users should be familiar with surgical procedures and techniques involving absorbable sutures before employing for wound closure, as the risk of wound dehiscence may vary with the site of application and the suture material used. Surgeons should consider the in vivo performance (under PERFORMANCE section) when selecting a suture.

 

[johnmpc]

Bit more complicated once you talk about long sentences. Because words like "a" and "in" are within other words.

See if this is close enough.

Sub CompareWords()
Dim xStr() As String
Dim i As Long
Dim x As Long, y As Long

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, "D").End(xlUp).Row
xStr = Split(.Cells(i, "D").Value, " ")
With .Cells(i, "B")
.Font.ColorIndex = 1
For x = LBound(xStr()) To UBound(xStr())
For y = 1 To Len(.Text)
If Mid(.Text, y, Len(xStr(x))) = xStr(x) Then

.Characters(y, Len(xStr(x))).Font.ColorIndex = 4

End If
Next y
Next x
End With
Next i
End With
MsgBox "completed"
End Sub