Compare two sentences and highlight in different color

vlnmca

New Member
Joined
Sep 12, 2014
Messages
8
Hi all,

I want to compare two cells in excel using macro and populate the difference after executing the macro.

If any body has worked on this requesting your help in this regard.


this is the my house
this is huge the house
tests are normal
tests normal
there is a small pot
this is pot
this is sum
this is huge sum
Just be to change addresses in the below to match your worksheet.
Just be sure to the change addresses in the lines to match worksheet.
Since added requirements in the comments below, I modified the code to also print out the list of red-highlighted phrases in column C. If you want this list elsewhere, you'll have adjust the address in the last section of the code. I also improved code
Since you added requirements in the comments below, I modified the code to also print out the list of red-highlighted phrases in column C. If you want this list elsewhere, you'll have to adjust the address in the last section of the code. I also improved the highlighting code

<tbody>
</tbody>
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Try this:-
Results column "D"
Code:
[COLOR="Navy"]Sub[/COLOR] MG13Sep27
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Sp          [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Sp1         [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Sp2         [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] nDif        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nn          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   Sp1 = Split(Dn.Value, " "): Sp2 = Split(Dn.Offset(, 1).Value, " ")
    Sp = Array(Sp1, Sp2)
    [COLOR="Navy"]For[/COLOR] n = 0 To 1
        [COLOR="Navy"]For[/COLOR] nn = 0 To UBound(Sp(n))
            [COLOR="Navy"]If[/COLOR] Not .Exists(Sp(n)(nn)) [COLOR="Navy"]Then[/COLOR]
                .Add Sp(n)(nn), Nothing
            [COLOR="Navy"]Else[/COLOR]
                .Remove Sp(n)(nn)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] nn
    [COLOR="Navy"]Next[/COLOR] n
    Dn.Offset(, 3) = Join(.keys, ",")
    .RemoveAll
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Thanks for your code. Can you please help how to highlight this words in column A and column B.

Try this:-
Results column "D"
Code:
[COLOR=navy]Sub[/COLOR] MG13Sep27
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Sp          [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Sp1         [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Sp2         [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] nDif        [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] nn          [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
   Sp1 = Split(Dn.Value, " "): Sp2 = Split(Dn.Offset(, 1).Value, " ")
    Sp = Array(Sp1, Sp2)
    [COLOR=navy]For[/COLOR] n = 0 To 1
        [COLOR=navy]For[/COLOR] nn = 0 To UBound(Sp(n))
            [COLOR=navy]If[/COLOR] Not .Exists(Sp(n)(nn)) [COLOR=navy]Then[/COLOR]
                .Add Sp(n)(nn), Nothing
            [COLOR=navy]Else[/COLOR]
                .Remove Sp(n)(nn)
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] nn
    [COLOR=navy]Next[/COLOR] n
    Dn.Offset(, 3) = Join(.keys, ",")
    .RemoveAll
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
This code will highlights non duplicate words, but sometimes, because where there are duplicate words in a particular cell, it will color the wrong version of that word.
Code:
[COLOR=Navy]Sub[/COLOR] MG13Sep25
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Sp          [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Sp1         [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Sp2         [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] nDif        [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] nn          [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] R           [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] k
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
   Sp1 = Split(Dn.Value, " "): Sp2 = Split(Dn.Offset(, 1).Value, " ")
    Sp = Array(Sp1, Sp2)
    [COLOR=Navy]For[/COLOR] n = 0 To 1
        [COLOR=Navy]For[/COLOR] nn = 0 To UBound(Sp(n))
            [COLOR=Navy]If[/COLOR] Not .Exists(Sp(n)(nn)) [COLOR=Navy]Then[/COLOR]
              [COLOR=Navy]Set[/COLOR] R = IIf(n = 0, Dn, Dn.Offset(, 1))
                .Add Sp(n)(nn), Array(R, InStr(R.Value, Sp(n)(nn)))
            [COLOR=Navy]Else[/COLOR]
                .Remove Sp(n)(nn)
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] nn
    [COLOR=Navy]Next[/COLOR] n
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] .Keys
            .Item(k)(0).Characters(.Item(k)(1), Len(k)).Font.ColorIndex = 3
    [COLOR=Navy]Next[/COLOR] k
    Dn.Offset(, 3) = Join(.Keys, ",") 'Remove this line if you don'r want the values in column "D"
    .RemoveAll
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] With


[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Micke,

Thanks for your code.

Still some words are not properly highlighted by the current code sent by you. kindly guide me.

column A line
Since added requirements in the comments below, I modified the code to also print out the list of red-highlighted phrases in column C. If you want this list elsewhere, you'll have adjust the address in the last section of the code. I also improved code

highlighted by current code sent by you
Since you added requirements in the comments below, I modified the code to also print out the list of red-highlighted phrases in column C. If you want this list elsewhere, you'll have to adjust the address in the last section of the code. I also improved the highlighting code

actual highlighting to be made
Since you added requirements in the comments below, I modified the code to also print out the list of red-highlighted phrases in column C. If you want this list elsewhere, you'll have to adjust the address in the last section of the code. I also improved the highlighting code


This code will highlights non duplicate words, but sometimes, because where there are duplicate words in a particular cell, it will color the wrong version of that word.
Code:
[COLOR=navy]Sub[/COLOR] MG13Sep25
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Sp          [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Sp1         [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Sp2         [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] nDif        [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] nn          [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] R           [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] k
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
   Sp1 = Split(Dn.Value, " "): Sp2 = Split(Dn.Offset(, 1).Value, " ")
    Sp = Array(Sp1, Sp2)
    [COLOR=navy]For[/COLOR] n = 0 To 1
        [COLOR=navy]For[/COLOR] nn = 0 To UBound(Sp(n))
            [COLOR=navy]If[/COLOR] Not .Exists(Sp(n)(nn)) [COLOR=navy]Then[/COLOR]
              [COLOR=navy]Set[/COLOR] R = IIf(n = 0, Dn, Dn.Offset(, 1))
                .Add Sp(n)(nn), Array(R, InStr(R.Value, Sp(n)(nn)))
            [COLOR=navy]Else[/COLOR]
                .Remove Sp(n)(nn)
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] nn
    [COLOR=navy]Next[/COLOR] n
   [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] k [COLOR=navy]In[/COLOR] .Keys
            .Item(k)(0).Characters(.Item(k)(1), Len(k)).Font.ColorIndex = 3
    [COLOR=navy]Next[/COLOR] k
    Dn.Offset(, 3) = Join(.Keys, ",") 'Remove this line if you don'r want the values in column "D"
    .RemoveAll
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With


[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
You are very unlikely to get a helpful response now that you have posted the same question in multiple forums with no cross references or apologies for cross posting.
 
Upvote 0
Hi VoG,

If you not that much expert in excel macro why are you stopping others from giving wrong comments. Please allow others to give solution for my problem.
 
Upvote 0
If you must cros post then we simply ask that you provide links to the other sites where you have posted the same question.

Of course I am not qualified to answer your question - I am a mere MVP.
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top