WORDIF Formating in VBA

[DianeDelRio]

Hello, I I am working on trying to find the differences between a string of words in selected cells. I attempted to use the Wordif function, and got the changes, however I would just like to format the changes in red.

For example

Currently Cells Show:
A1: The green dog likes to run .
B1: A green dog really likes to run sometimes.

Macro/VBA used Should Show:
A2: The green dog likes to run.
B2: A green dog really likes to run sometimes.

Or something of that nature. Essentially I would like to compare the two cell "versions" to spot the differences.
If you could assist with a macro that can format the color and show redacted words/ additional spaces added, that would be incredible.

P.S. Currently this is the macro I am using- it shows the differences, but leaves the words as "-", rather than just changing the font.
Please let me know if you need any further information.

Function WORDDIF(rngA As Range, rngB As Range) As String

Dim WordsA As Variant, WordsB As Variant
Dim ndxA As Long, ndxB As Long, strTemp As String

WordsA = Split(rngA.Text, " ")
WordsB = Split(rngB.Text, " ")

For ndxB = LBound(WordsB) To UBound(WordsB)
For ndxA = LBound(WordsA) To UBound(WordsA)
If StrComp(WordsA(ndxA), WordsB(ndxB), vbTextCompare) = 0 Then
WordsA(ndxA) = vbNullString
Exit For
End If
Next ndxA
Next ndxB

For ndxA = LBound(WordsA) To UBound(WordsA)
strTemp = strTemp & IIf(WordsA(ndxA) <> vbNullString, WordsA(ndxA), "-") & " "
Next ndxA

WORDDIF = Trim(strTemp)


End Function

 

[Akuini]

Deleted, sorry the code is flawed.

 

[Akuini]

Try this:
Select 2 cells (contiguous or non contiguous) to compare then run the code:

[FONT=Lucida Console][COLOR=Royalblue]Sub[/COLOR] WORDDIF_3()
[I][COLOR=Dimgray]'https://www.mrexcel.com/forum/excel-questions/1113683-wordif-formating-vba.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] ary, arz, x
[COLOR=Royalblue]Dim[/COLOR] n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range, d [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] txc [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR], txd [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

[COLOR=Royalblue]If[/COLOR] Selection.Cells.count <> [COLOR=Brown]2[/COLOR] [COLOR=Royalblue]Then[/COLOR]
MsgBox [COLOR=Darkcyan]"You must select only [COLOR=Brown]2[/COLOR] cells"[/COLOR]: [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Sub[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]If[/COLOR] Selection.Areas.count = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]Then[/COLOR]
    [COLOR=Royalblue]Set[/COLOR] c = Selection([COLOR=Brown]1[/COLOR]): [COLOR=Royalblue]Set[/COLOR] d = Selection([COLOR=Brown]2[/COLOR])
    [COLOR=Royalblue]Else[/COLOR]
    [COLOR=Royalblue]Set[/COLOR] c = Selection.Areas([COLOR=Brown]1[/COLOR]): [COLOR=Royalblue]Set[/COLOR] d = Selection.Areas([COLOR=Brown]2[/COLOR])
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

txc = c: txd = d

      [COLOR=Royalblue]For[/COLOR] i = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] Len(txc)
        [COLOR=Royalblue]If[/COLOR] Mid(txc, i, [COLOR=Brown]1[/COLOR]) [COLOR=Royalblue]Like[/COLOR] [COLOR=Darkcyan]"[!A-Za-z0-[COLOR=Brown]9[/COLOR] ']"[/COLOR] [COLOR=Royalblue]Then[/COLOR] Mid(txc, i, [COLOR=Brown]1[/COLOR]) = [COLOR=Darkcyan]" "[/COLOR]
      [COLOR=Royalblue]Next[/COLOR]
    
      [COLOR=Royalblue]For[/COLOR] i = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] Len(txd)
        [COLOR=Royalblue]If[/COLOR] Mid(txd, i, [COLOR=Brown]1[/COLOR]) [COLOR=Royalblue]Like[/COLOR] [COLOR=Darkcyan]"[!A-Za-z0-[COLOR=Brown]9[/COLOR] ']"[/COLOR] [COLOR=Royalblue]Then[/COLOR] Mid(txd, i, [COLOR=Brown]1[/COLOR]) = [COLOR=Darkcyan]" "[/COLOR]
      [COLOR=Royalblue]Next[/COLOR]
    
ary = Split(WorksheetFunction.Trim(txc), [COLOR=Darkcyan]" "[/COLOR]): arz = Split(WorksheetFunction.Trim(txd), [COLOR=Darkcyan]" "[/COLOR])
    
    j = [COLOR=Brown]1[/COLOR]
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x In ary
   
            [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(Application.Match(x, arz, [COLOR=Brown]0[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
                n = InStr(j, c, x, [COLOR=Brown]1[/COLOR])
                c.Characters(n, Len(x)).Font.Color = vbRed
                j = n + Len(x) - [COLOR=Brown]1[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]Next[/COLOR]
    
    j = [COLOR=Brown]1[/COLOR]
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x In arz
    
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(Application.Match(x, ary, [COLOR=Brown]0[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
            n = InStr(j, d, x, [COLOR=Brown]1[/COLOR])
            d.Characters(n, Len(x)).Font.Color = vbRed
            j = n + Len(x) - [COLOR=Brown]1[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]Next[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

Example:
Check the combobox setting in sheet1, sheet2.
It's combobox settings in sheet1 and sheet2 and sheet3.

 

[DianeDelRio]

This is incredible! Thank you.

Is it at all possible to remove the 2 cell at a time caveat? I'd like to implement this across multiple rows of data at once. However, as a start- it works as intended!!

 

[Akuini]

I'd like to implement this across multiple rows of data at once

How do you mean?
Say you select 4 cells e.g A1:A4, then the comparison is still between 2 cells, isn't it?
So between A1 & A2 and then between A3 & A4. Is that what you mean?

 

[DianeDelRio]

Not quite, I would like to compare A1:B1, A2:B2, A3:B3, etc. As it stands, if I attempt to select multiple rows (keeping the two column comparison)- it gives me the "2 cells must be selected" error.

 

[Akuini]

Ok, put the data in col A:B then run the code.

[FONT=Lucida Console][COLOR=Royalblue]Sub[/COLOR] WORDDIF_4()
[I][COLOR=Dimgray]'https://www.mrexcel.com/forum/excel-questions/1113683-wordif-formating-vba.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] ary, arz, x
[COLOR=Royalblue]Dim[/COLOR] n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range, d [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] txc [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR], txd [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

Application.ScreenUpdating = False
[COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] c In Range([COLOR=Darkcyan]"A1"[/COLOR], Cells(Rows.count, [COLOR=Darkcyan]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
[COLOR=Royalblue]Set[/COLOR] d = c.Offset(, [COLOR=Brown]1[/COLOR])
txc = c: txd = d

      [COLOR=Royalblue]For[/COLOR] i = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] Len(txc)
        [COLOR=Royalblue]If[/COLOR] Mid(txc, i, [COLOR=Brown]1[/COLOR]) [COLOR=Royalblue]Like[/COLOR] [COLOR=Darkcyan]"[!A-Za-z0-[COLOR=Brown]9[/COLOR] ']"[/COLOR] [COLOR=Royalblue]Then[/COLOR] Mid(txc, i, [COLOR=Brown]1[/COLOR]) = [COLOR=Darkcyan]" "[/COLOR]
      [COLOR=Royalblue]Next[/COLOR]
    
      [COLOR=Royalblue]For[/COLOR] i = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] Len(txd)
        [COLOR=Royalblue]If[/COLOR] Mid(txd, i, [COLOR=Brown]1[/COLOR]) [COLOR=Royalblue]Like[/COLOR] [COLOR=Darkcyan]"[!A-Za-z0-[COLOR=Brown]9[/COLOR] ']"[/COLOR] [COLOR=Royalblue]Then[/COLOR] Mid(txd, i, [COLOR=Brown]1[/COLOR]) = [COLOR=Darkcyan]" "[/COLOR]
      [COLOR=Royalblue]Next[/COLOR]
    
ary = Split(WorksheetFunction.Trim(txc), [COLOR=Darkcyan]" "[/COLOR]): arz = Split(WorksheetFunction.Trim(txd), [COLOR=Darkcyan]" "[/COLOR])
    
    j = [COLOR=Brown]1[/COLOR]
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x In ary
   
            [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(Application.Match(x, arz, [COLOR=Brown]0[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
                n = InStr(j, c, x, [COLOR=Brown]1[/COLOR])
                c.Characters(n, Len(x)).Font.Color = vbRed
                j = n + Len(x) - [COLOR=Brown]1[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]Next[/COLOR]
    
    j = [COLOR=Brown]1[/COLOR]
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x In arz
    
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] IsNumeric(Application.Match(x, ary, [COLOR=Brown]0[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
            n = InStr(j, d, x, [COLOR=Brown]1[/COLOR])
            d.Characters(n, Len(x)).Font.Color = vbRed
            j = n + Len(x) - [COLOR=Brown]1[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    [COLOR=Royalblue]Next[/COLOR]

[COLOR=Royalblue]Next[/COLOR]
Application.ScreenUpdating = True
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[DianeDelRio]

Perfect! Thank you so much, you're a lifesaver!

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.