Compare words in 2 cells highlighting the same words or different words

[burniksapwet]

I found this code online guys and I need help updating it.

Sub Macro1()
Dim xRg1 As Range
Dim xRg2 As Range
Dim xTxt As String
Dim xCell1 As Range
Dim xCell2 As Range
Dim I As Long
Dim J As Integer
Dim xLen As Integer
Dim xDiffs As Boolean
On Error Resume Next
If ActiveWindow.RangeSelection.count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
lOne:
Set xRg1 = Application.InputBox("Range A:", "Kutools for Excel", xTxt, , , , , 8)
If xRg1 Is Nothing Then Exit Sub
If xRg1.Columns.count > 1 Or xRg1.Areas.count > 1 Then
MsgBox "Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
GoTo lOne
End If
lTwo:
Set xRg2 = Application.InputBox("Range B:", "Kutools for Excel", "", , , , , 8)
If xRg2 Is Nothing Then Exit Sub
If xRg2.Columns.count > 1 Or xRg2.Areas.count > 1 Then
MsgBox "Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
GoTo lTwo
End If
If xRg1.CountLarge <> xRg2.CountLarge Then
MsgBox "Two selected ranges must have the same numbers of cells ", vbInformation, "Kutools for Excel"
GoTo lTwo
End If
xDiffs = (MsgBox("Click Yes to highlight similarities, click No to highlight differences ", vbYesNo + vbQuestion, "Kutools for Excel") = vbNo)
Application.ScreenUpdating = False
xRg2.Font.ColorIndex = xlAutomatic
For I = 1 To xRg1.count
Set xCell1 = xRg1.Cells(I)
Set xCell2 = xRg2.Cells(I)
If xCell1.Value2 = xCell2.Value2 Then
If Not xDiffs Then xCell2.Font.Color = vbRed
Else
xLen = Len(xCell1.Value2)
For J = 1 To xLen
If Not xCell1.Characters(J, 1).Text = xCell2.Characters(J, 1).Text Then Exit For
Next J
If Not xDiffs Then
If J <= Len(xCell2.Value2) And J > 1 Then
xCell2.Characters(1, J - 1).Font.Color = vbRed
End If
Else
If J <= Len(xCell2.Value2) Then
xCell2.Characters(J, Len(xCell2.Value2) - J + 1).Font.Color = vbRed
End If
End If
End If
Next
Application.ScreenUpdating = True
End Sub

What this will do is lets say you have this statement in column A and column B

A____________________________B
Jason is driving there_______Jason is walking there

If you compare A to B then it will highlight that the same words "Jason is" and it will turn the text red. What i want it to do is basically search of every word in column A (or whatever column you select) and not just turn the text up to the point that they are similar. So in this instance I want the macro to work to were it will highlight and turn the text red for the word there because it is present in both columns regardless of whats in between them.

The result will be like this

A____________________________B
Jason is driving there_______Jason is walking there

Im hoping to get something like this
A____________________________B
Jason is driving there_______Jason is walking there

I hope someone will be able to help me out with this problem and would like to thank all who are willing to help in advance. Thank you so much.

 

[burniksapwet]

It may not be always be right next to each other. I cannot predict how we will get the data. And yes let’s make the second one always the one that has the red text. Thank you.

 

[Peter_SSs]

OK, given that info, try this. If the columns were D and F just enter D,F in the InputBox but if you did want the highlighted words in column D based on the words in column F then just enter the column letters in the reverse order (F,D)
I have allowed for columns up to ZZ to be used.

Sub Matching_Words_v2()
  Dim RX As Object, M As Object
  Dim a As Variant, b As Variant, itm As Variant, Cols As Variant
  Dim Resp As String
  Dim i As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "[A-Z]{1,2}\,[A-Z]{1,2}"
  Resp = InputBox("Enter the two column letters separated by a comma. e.g. C,G")
  If RX.Test(Replace(Resp, " ", "")) Then
    Application.ScreenUpdating = False
    Cols = Split(Replace(Resp, " ", ""), ",")
    a = Range(Cols(0) & 1, Range(Cols(0) & Rows.Count).End(xlUp)).Value
    With Range(Cols(1) & 1).Resize(UBound(a))
      .Font.Color = vbBlack
      b = .Value
      For i = 1 To UBound(a)
        RX.Pattern = "\b(" & Replace(a(i, 1), " ", "|") & ")\b"
        Set M = RX.Execute(b(i, 1))
        With .Cells(i, 1)
          For Each itm In M
            .Characters(itm.firstindex + 1, Len(itm)).Font.Color = vbRed
          Next itm
        End With
      Next i
    End With
    Application.ScreenUpdating = True
  Else
    MsgBox "Not a valid entry"
  End If
End Sub

 

[burniksapwet]

I found a little wrinkle in the code. I think it does not like special characters and some of the misspellings are not getting caught. I am not quite sure what's going on for those. Mind if you take a look at it for please? Thank you.

SearchExport_L0A1642018240705.xlsx
	A	B
1	Document Title	Document Title
2	VARIABLE FREQUENCY DRIVE; YASKAWA AMERICA, INC; CIMR-ZU4A0034FAA (STORES ITEM NO: 45126)	VARIABLE FREQUENCY DRIVE; YASKAWA AMERICA, INC; CIMR-ZU4A0034FAA (STORES ITEM NO: 45126)
3	VALVE BALL 1 INCH; APOLLO; 94ALF-105-01A (STORES ITEM NO: 44696)	VALVE BALL 1 INCH; APOLLO; 94ALF-105-01A (STORES ITEM NO: 44696)
4	MOTOR; BALDOR RELIANCE ELECTRIC; ECP83770T-4 (STORES ITEM NO: 44644)	MOTOR; BALDOR RELIANCE ELECTRIC; ECP83770T-4 (STORES ITEM NO: 44644)
5	MISCELLANEOUS EQUIPMENT; ELECTRIC VEHICLE CART; YAMAHA; G14FM1 GOLF CART (STORES ITEM NO: 45171)	MISCELLANEOUS EQUIPMENT; ELECTRIC VEHICLE CART; YAMAHA; G14FM1 GOLF CART (STORES ITEM NO: 45171)
6	VARIABLE FREQUENCY DRIVE; ALLEN-BRADLEY; 22B-D6P0N104 (STORES ITEM NO: 45075)	VARIABLE FREQUENCY DRIVE; ALLEN-BRADLEY; 22B-D6P0N104 (STORES ITEM NO: 45075)
7	ACTIVE INSTRUMENT; SENSOR; YSI; MIQ TC 2020 3G-H3 (STORES ITEM NO: 42941)	ACTIVE INSTRUMENT; SENSOR; YSI; MIQ TC 2020 3G-H3 (STORES ITEM NO: 42941)
8
9	MISCELLANEOUS	MMMMMMMMMISCELLANEOUS
10	MISCELLANEOUS EQUIPMENT; ELECTRIC VEHICLE CART; YAMAHA; G14FM1 GOLF CART (STORES ITEM NO: 45171)	MMMMMMMMMISCELLANEOUS EQUIPMENT; ELECTRIC VEHICLE CART; YAMAHA; G14FM1 GOLF CART (STORES ITEM NO: 45171)
SearchExport_L0A1642018240705

I dont know why Xl2bb is not displaying properly but I will send a screen shot of what I have. Some text showing as black when in reality what I see on my screen is red.

 

[Peter_SSs]

I dont know why Xl2bb is not displaying properly

XL2BB is not designed to analyse the colour of every character in every cell, that would be a lot to ask. As a result, it uses the colour of the first character in the cell for all the characters in the cell.
So if you want to show the colour of individual characters then you need to post an image as you have done.

I think it does not like special characters

Excel is more designed to work with numerical data than for text manipulation or analysis so this sort of thing often happens when punctuation/special characters are involved.
A further complication with your data is that some lines of data contain double spaces. That is why some rows have turned completely red.

To assess whether I can produce the exact result that you want, I would like to see what that result is for that particular sample data. Can you manually carefully colour column B of that exact sample data as you would like to have it and post an image of that?

 

[burniksapwet]

So for the sample I initially gave you I don't know what happened there because all I did was copied what was in column A and pasted in on B. So they are technically the same thing. I did no manipulation on it. I was just trying out the code at the point.

So now I am providing what you are requesting and I hope there can be something that gets done about it. Thank you in advance once again.

SearchExport_SF31642035410153.xlsx
	A	B
1	Document Title	Comapred That Maches
2	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)
3	ACTIVE INSTRUMENT; FLOW CONVERTER; FISCHER PORTER; MAG-X 50PZ1271B1 (STORES ITEM NO: 42009)	ACTIVE INSTRUMENT; FLOW CONVERTER; FISCHER PORTER; MAG-X 50PZ1271B1 (STORES ITEM NO: 42009)
4	ACTIVE INSTRUMENT; FLOW ELEMENT; 6 INCH; KROHNE-AMERICA; OPTIFLUX 4000 (STORES ITEM NO: 43681)	ACTIVE INSTRUMENT; FLOW ELEMENT; 6 INCH; KROHNE-AMERICA; OPTIFLUX 4000 (STORES ITEM NO: 43681)
5	ACTIVE INSTRUMENT; FLOW INDICATOR TRANSMITTER; ENDRESS & HAUSER; 5W4CV0-C6FLHP5DHW1KGA (STORES ITEM NO: 44636)	ACTIVE INSTRUMENT; FLOW INDICATOR TRANSMITTER; ENDRESS & HAUSER; 5W4CV0-C6FLHP5DHW1KGA (STORES ITEM NO: 44636)
6	ACTIVE INSTRUMENT; PRESSURE INDICATING TRANSMITTER; ROSEMOUNT; 1151DP3S22B1M3 (STORES ITEM NO: 43776)	ACTIVE INSTRUMENT; PRESSURE INDICATING TRANSMITTER; ROSEMOUNT; 1151DP3S22B1M3 (STORES ITEM NO: 43776)
7	ACTUATOR; PNEUMATIC; 4 INCH; SIEMENS; FLOWRITE AP 599-01000 (STORES ITEM NO: 41994)	ACTUATOR; PNEUMATIC; 4 INCH; SIEMENS; FLOWRITE AP 599-01000 (STORES ITEM NO: 41994)
8	COMPONENT; SOLENOID; 24V; KAESER COMPRESSOR; 7.5453.10031 (STORES ITEM NO: 43926)	COMPONENT; SOLENOID; 24V; KAESER COMPRESSOR; 7.5453.10031 (STORES ITEM NO: 43926)
9	VALVE; BALL; .25 INCH; APOLLO; 64-101 (STORES ITEM NO: 43470)	VALVE; BALL; .25 INCH; APOLLO; 64-101 (STORES ITEM NO: 43470)
10	VALVE; BALL; .25 INCH; APOLLO; 76-101-01A (STORES ITEM NO: 41925)	VALVE; BALL; .25 INCH; APOLLO; 76-101-01A (STORES ITEM NO: 41925)
11	VALVE; BALL; .5 INCH; APOLLO; 70-103-01 (STORES ITEM NO: 43155)	Valve; Ball; .5 Inch; Apollo; 70-103-01 (Stores Item No: 43155)
12	VALVE; BUTTERFLY; 2.5 INCH; BRAY; 31-0250-370 (STORES ITEM NO: 42075)	Valve; Butterfly; 2.5 Inch; Bray; 31-0250-370 (Stores Item No: 42075)
13
14	Document Title	Misspelled
15	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)	AAAAAAAACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)
16	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)	ACTIVE INSTRUMENT; ANALYZER ELEMENTTTTTTTT; YSI; SENSOLYT 70000000 IQ (STORES ITEM NO: 42943)
17
18	Document Title	Wrong stores item number
19	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 429431234561354)
20
21	Document Title	Extra Words
22	ACTIVE INSTRUMENT; ANALYZER ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)	ACTIVE extra word INSTRUMENT; ANALYZER insert word here ELEMENT; YSI; SENSOLYT 700 IQ (STORES ITEM NO: 42943)
SearchExport_SF31642035410153

What is attached on the picture is how I wish the comparison macro would work. It basically turn all the text red that is present in column a and keep the ones that are not present in a black. This is for all any situation meaning for text, numbers, and special characters. Thank you.

 

[Peter_SSs]

There still could be a few problems arise as "regular expressions", as used in this code, use certain characters to have special meaning within the regular expression system. Each of these need to be dealt with if they are to be treated as literal text rather than their regular expression meaning. In your sample data, the most obvious of these are opening and closing parentheses.

In the code below, I have defined a "word" as any string of non-space characters bounded by spaces or the beginning or end of the entire text.
As far as I can see it produces the results you want apart from two minor instances.

The first is in row 16 where your result has a red ";" at the end of "ELEMENTTTTTTTT;" whereas my definition of a "word" above includes the semicolon as part of the "word" and therefore leaves it black since that "word" does not appear in the column A text.
The second is in row 19 where the ")" at the end of "429431234561354)" gets exactly the same treatment for exactly the same reason.

I hope this is useful enough for you.

Sub Matching_Words_v3()
  Dim RX As Object, M As Object
  Dim a As Variant, b As Variant, itm As Variant, Cols As Variant
  Dim Resp As String
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "[A-Z]{1,2}\,[A-Z]{1,2}"
  Resp = InputBox("Enter the two column letters separated by a comma. e.g. C,G")
  If RX.Test(Replace(Resp, " ", "")) Then
    Application.ScreenUpdating = False
    Cols = Split(Replace(Resp, " ", ""), ",")
    a = Range(Cols(0) & 1, Range(Cols(0) & Rows.Count).End(xlUp)).Value
    With Range(Cols(1) & 1).Resize(UBound(a))
      .Font.Color = vbBlack
      b = .Value
      For i = 1 To UBound(a)
        RX.Pattern = "(^| )(" & Replace(Replace(Replace(Application.Trim(a(i, 1)), "(", "\("), ")", "\)"), " ", "|") & ")(?= |$)"
        Set M = RX.Execute(b(i, 1))
        With .Cells(i, 1)
          For Each itm In M
            .Characters(itm.firstindex + 1, Len(itm)).Font.Color = vbRed
          Next itm
        End With
      Next i
    End With
    Application.ScreenUpdating = True
  Else
    MsgBox "Not a valid entry"
  End If
End Sub

Here is my sample data and results

 

[burniksapwet]

Sorry my bad about missing the; it should have turned red. Should have paid more attention to it.

 

[burniksapwet]

Sorry let me take that back. You I think it is correct that the ; should not have turned red as it was part of a incorrect word. there is no space in between. The code is working perfectly. Thank you so much.

 

[Peter_SSs]

The code is working perfectly. Thank you so much.

You're welcome. Thanks for the confirmation.

 

[burniksapwet]

Last question about this VBA macro. Sorry for asking this, I tried to do it on my own but I'm failing and could not figure out what lines to change. Can you create a new one of this last update you made that functions like the first code you made? What I mean by that is one that will only compare columns a and b without having to select the columns? This way I have a code that just does it without any user input of which cells to pick. I just need this for some occasions that it will always be in a and b. I do want to have both macros. Thank you.