Compare text between 2 cells and highlight differences

[superlbc]

Hi,

I am trying to compare the text content of two cells.
Basically, there is a review of the text in 100+ cells in column M, which is introduced in column O.
I would like the macro to highlight the differences for cells in those two columns (i.e. M1 to O1, M2 to O2, etc).

I would like to highlight the differences in red and bold, without changing the case or any other properties.

i.e.

M1 = Text in column M.
O1 = Reviewed text in Column O

"Reviewed" should be highlighted, as well as "M", "O" and "."

It should be case sensitive as well.

My knowledge is very limited when it comes to VBA.

I have been doing some research around and I found the code below, which partially works, but not completely.

Sub Compare()

If StringCompareHighlight(Range("m1"), Range("o1")) Then
      Range("q1").Value = "Match"
Else
      Range("q1").Value = "Not Match"
End If


If StringCompareHighlight(Range("m2"), Range("o2")) Then
      Range("q2").Value = "Match"
Else
      Range("q2").Value = "Not Match"
End If


If StringCompareHighlight(Range("m3"), Range("o3")) Then
      Range("q3").Value = "Match"
Else
      Range("q3").Value = "Not Match"
End If

End Sub

Function StringCompareHighlight(r1 As Range, r2 As Range) As Boolean
''this function compare the words from 2 strings
''each word is separated by "," and the order of these words does not matter
''return true if matches, False if not match
''changes the format of a word in one string that does not exist in the other string
Dim oMatches As Object, oMatch As Object
Dim r(1 To 2) As Range
Dim i As Integer, bDiff As Boolean, iStart As Integer
 
Set r(1) = r1
Set r(2) = r2
With CreateObject("vbscript.regexp")
    .Pattern = " *(\w+) *(?= .*\|)(?!.*\|.* *\1 *)"
    .Global = True
    .IgnoreCase = True
 
    For i = 1 To 2
        Set oMatches = .Execute(" " & r(i).Text & ",|," & r(3 - i).Text & " ")
        For Each oMatch In oMatches
            iStart = InStr(oMatch.FirstIndex + 1, r(i).Text, oMatch.submatches(0), vbTextCompare)
            With r(i).Characters(Start:=iStart, Length:=Len(oMatch.submatches(0))).Font
                .Bold = True
                .Size = 14
            End With
        Next oMatch
        If oMatches.Count > 0 Then bDiff = True
    Next i
End With
StringCompareHighlight = Not bDiff
End Function

Can someone help me with this?

Many thanks,

Luis

 

[GlennUK]

You say in your example:

M1 = Text in column M.
O1 = Reviewed text in Column O

"Reviewed" should be highlighted, as well as "M", "O" and "."

It should be case sensitive as well.

If it's case sensitive then Text does not equal text, and Column does not equal column. How should they be highlighted?

What is it about the code that does not work completely? How close to your required solution is it?

 

[superlbc]

Thanks for your reply Glenn,

The code checks the text in 2 different cells (columns M and O) in the same row.

If I check with a basic string, it works, except if I modify the last word of the cell, then it does not work. Let's say, same text in the two rows, if I add a word or modify the word in one of the cells, the code increases the size of the words that have been added or changed. It checks and applies the same rule to both cells.

Now, there are cases were it does not work. For example, in following text:

Customers and staff alike will appreciate the XXX's unobtrusive noise levels, which are as low as 51dBA.

The 'S' version has a high-accuracy YYY head for smooth, trouble-free handling of cheques and passbooks.

Somehow, even when I don't change anything, the code marks the first word (Customers) and a few words of the second paragraph, and I don't understand why.

I just need the code to higlight (currently changing the format, ideally just changing the font color to red) any change made in any of the two cells, regardless it is between spaces, at the end of a sentence.

Thank you,

Luis

 

[GlennUK]

Having multiple paragraphs in a cell seems to break it. I don't know RegExp at all, so can't help you, I'm afraid.

 

[superlbc]

Hi Glenn,

Thanks for your reply.

Do you know how to break each sentence contained into a single cell into different cells, where the "." marks the end of the sentence?

Example:

A1: Sentence number 1a. Sentence number 2a. Sentence number 3a.
A2: Sentence number 1b. Sentence number 2b.

Should become:

A1: Sentence number 1a.
A2: Sentence number 2a.
A3: Sentence number 3a.
A4: Sentence number 1b.
A5: Sentence number 2b.

That way, I could use the code to compare, I don't mind if the text is kept on the same cell or not, as long as it is correlative.

Thanks,

Luis

 

[GlennUK]

First use Text To columns, Separator of "." to break into separate cells horizontally. Then use this method to change layout to be vertical, and then filter out any blank rows :

http://www.tek-tips.com/faqs.cfm?fid=5287

 

[Kiru_m13]

Hi Luis,

Did u find the soultion for the comparison requirement as said above? I am currently in need of same comparison requirement. Please Help.

Kiru

 

[Jwilly]

Hi,

The OP's code is working for me. However, is there a way to have this check each cell against the one next to it (D4 v E4, D5 v. E5, etc) over a range of cells. I want to repeat this function over 3000 cells but I was hoping there was an easier way than to copy the first 'IF' statement and change the cell number 3000 times. I tired to tell it check for a range but then it was comparing one cell vs every cell in that range, and that is not what I want.

Thanks for your help.

 

[Clmarcela]

Hello,

Please can someone help me changing this code in order to identify the different text, I mean that the code does not highlight the non-common text but the one that is common.

[COLOR=#333333]Sub Compare()[/COLOR]
If StringCompareHighlight(Range("m1"), Range("o1")) Then      Range("q1").Value = "Match"Else      Range("q1").Value = "Not Match"End IfIf StringCompareHighlight(Range("m2"), Range("o2")) Then      Range("q2").Value = "Match"Else      Range("q2").Value = "Not Match"End IfIf StringCompareHighlight(Range("m3"), Range("o3")) Then      Range("q3").Value = "Match"Else      Range("q3").Value = "Not Match"End IfEnd SubFunction StringCompareHighlight(r1 As Range, r2 As Range) As Boolean''this function compare the words from 2 strings''each word is separated by "," and the order of these words does not matter''return true if matches, False if not match''changes the format of a word in one string that does not exist in the other stringDim oMatches As Object, oMatch As ObjectDim r(1 To 2) As RangeDim i As Integer, bDiff As Boolean, iStart As Integer Set r(1) = r1Set r(2) = r2With CreateObject("vbscript.regexp")    .Pattern = " *(\w+) *(?= .*\|)(?!.*\|.* *\1 *)"    .Global = True    .IgnoreCase = True     For i = 1 To 2        Set oMatches = .Execute(" " & r(i).Text & ",|," & r(3 - i).Text & " ")        For Each oMatch In oMatches            iStart = InStr(oMatch.FirstIndex + 1, r(i).Text, oMatch.submatches(0), vbTextCompare)            With r(i).Characters(Start:=iStart, Length:=Len(oMatch.submatches(0))).Font                .Bold = True                .Size = 14            End With        Next oMatch        If oMatches.Count > 0 Then bDiff = True    Next iEnd WithStringCompareHighlight = Not bDiff </pre>[COLOR=#333333]End Function[/COLOR]