Excel 365 VBA to compare original text in cell to new text and highlight differences

[DThib]

I need some code that will take a copy of a cell content paste it to another cell. Take the new text and compare content. If there is matching content leave black, highlight in red the new non-matching text no matter where it is in the cell.

can anyone point in the right direction. I have tried Len logic but it highlights all text if the new text it is to the left of the matching text.

 

[Dan_W]

When you post a question on this Forum, the system identifies 5 existing threads that are most similar/identical to your own. As it happens, three of them have code that accomplishes what you've asked for. One of them is: Compare words in 2 cells highlighting the same words or different words

Hope that helps.

 

[DThib]

Thank you for the reply. What this does is highlight (red) the entire string instead of the words that do not match the first text.
I need the non-matching words to be highlighted. They will occur at the beginning of the cell contents.

Is there a script to handle this case?

 

[DThib]

Here is a screen shot of the result from the replies you are referencing. Latest (Matching_Words_v3)
Compare words in 2 cells highlighting the same words or different words

26Jan: is being captured as different, which it is not.

 

[Dan_W]

I'm very sorry - I'm sure I had responded to this yesterday. I had undertaken two tests - using two of the methods explored in the linked thread - the character-by-character version and the regular expression version (the latter being the one more suitable for your purposes). I don't know why my reply didn't send - let me check when I get home in an hour.

 

[Dan_W]

Just looking at your reply though - I note that you said you wanted to the non-matching words to be highlighted rather than the matching words and (what I thought I had replied with yesterday was to say that) it is simply a matter of swapping the colour references in the the script. It isn't clear to me why the 26Jan: is being left out but I'll try it when I get home. Do you have an example of what your preferred outcome would look like?

 

[DThib]

Just looking at your reply though - I note that you said you wanted to the non-matching words to be highlighted rather than the matching words and (what I thought I had replied with yesterday was to say that) it is simply a matter of swapping the colour references in the the script. It isn't clear to me why the 26Jan: is being left out but I'll try it when I get home. Do you have an example of what your preferred outcome would look like?

Sure, here it is

I have swapped the references to highlight this way, but for some reason 26Jan: gets captured. Each date starts a new line.

 

[Dan_W]

Update: So I have good news and bad news.

The good news is I've solved the 26Jan: issue. I had to rewrite the regular expression pattern, and now that part is resolved.
The bad news:

Now there is a new odd-one-out - documentation. The other two are just tests, but I'm trying to work out why documentation is coming up as being different.

Will try again after work tonight. Just wanted to let you know that I hadn't forgotten.

 

[Dan_W]

Ok. I think I've got it working now:

I suspect there may be more issues, though, which we won't know unless you try testing it some more. I've done a few tests, but the better ones are 'real-world' ones. I've adjusted the pattern slightly, and rewritten part of the code - as below, you can see it takes the source text from Cell A1, and checks it against B1 - that's because I got tired of entering in the columns each time. That can be changed pretty easily.

    Sub DifferentWords()

        Dim Regex                  As Object
        Dim MatchingWords          As Object
        Dim Itm                    As Object
        Dim NewPattern             As String

        Set RX = CreateObject("VBScript.RegExp")
        RX.Global = True
        RX.IgnoreCase = True
        Set Source = Range("A1")
        Set Comparison = Range("B1")
        Source.Value = Application.Trim(Source.Value)
        Comparison.Value = Application.Trim(Comparison.Value)

        Application.ScreenUpdating = False
        With Comparison
            .Font.Color = vbRed
            .Font.Bold = True
        End With
        NewPattern = Replace("(" & Replace(Replace(Replace(Replace(Replace(Replace(Application.Trim(Source.Value), "(", "\("), ")", "\)"), " ", "|"), Chr(10), "|"), Chr(13), "|"), "/", "\/") & ")(?= |$|\n|\r)", "||", "|")
        RX.Pattern = NewPattern
        Set MatchingWords = RX.Execute(Comparison.Value)
        With Comparison
            For Each Itm In MatchingWords
                With .Characters(Itm.firstindex + 1, Len(Itm))
                    .Font.Color = vbBlack
                    .Font.Bold = False
                End With
            Next Itm
        End With
        Application.ScreenUpdating = True
    End Sub

 

[DThib]

Fantastic!
I can work with it from here.
I appreciate your help and the hard work put into this. It is going to be part of GUI execute I need.

DThib