Comparing text in cells

[NJActuary]

I have a spreadsheet that has long text sentences in each cell. I have a 2nd spreadsheet which is a slightly updated version of the first spreadsheet. The slight updates consisted of editing the odd word here or there out of the first spreadsheet.

Unfortunately, I didn't keep track of the changes I made, and I need to know what they are.

It's easy to tell if a change has been made, simply by comparing the cells. But I can't find an easy way to find out exactly what change was made. Comparing the cells a line at a time is very time consuming.

Any suggestions for how to reveal what changes were made?

Thanks.

 

[PA HS Teacher]

Here's a user defined function I made that should do the trick,

Hit Alt+F11 insert a module and paste this code in.

Function Dif(S1 As String, S2 As String) As String
Dim i As Integer, L As Integer
Dif = ""
If Len(S1) > Len(S2) Then
  L = Len(S2)
Else
  L = Len(S1)
End If

For i = 1 To L
  If Mid(S2, i, 1)<> Mid(S1, i, 1) Then
    Dif = Dif & Mid(S2, i, 1)
  Else
    Dif = Dif & " "
  End If
Next i
End Function

Example of use:

Book1
	A	B	C	D
1	HiBob,howareyou?	HiSteve,Howareyou?	Steve,Howareyo
2	Iliketomakespreadsheets.	Iliketowritespreadsheets.	writespreadshets
3	HiBob,howareyou?	HiJoe,howareyou?	Je
4	MorningDave	MorningIris	Iris
Sheet3

 

[Greg Truby]

OK - I have been wishing I had a tool like this for a while. Your post prompted me to go ahead and see what I could come up with. While it is not bulletproof - punctuation marks are not handled too well, at least for me it works pretty well. Here is an example of the inputs and output. Note that COLO's HTML maker does not capture in-cell formatting, so I have re-created the output below with the actual formatting.

Compare Text.xls
	A	B	C	D
1	Old	New	Compared
2	Anoldsentence,mytrustedoldfriend.	Thisisanewsentence,myfriend.	AnoldThisisanewsentence,mytrustedoldfriend.
3	Thiswasanoldsentence.	Anewsentence.	ThiswasanoldAnewsentence.
4	Thequickbrownfox.	Thequickredfox.	Thequickbrownredfox.
5	Bob,whereareyou?	Robert,whereareyou?	Bob,Robert,whereareyou?
6	MynameisGreg.	HernameisMargaret.	MyHernameisGreg.Margaret.
7	Apple,Banana,Cherry	apple,banana,cherry	Apple,Banana,Cherry
8	John	JohnmetJane.	JohnmetJane.
Sheet1 (2)

<strike>An old</strike> This is a new sentence, my <strike>trusted old</strike> friend.
<strike>This was an old</strike> A new sentence.
The quick <strike>brown</strike> red fox.
<strike>Bob,</strike> Robert, where are you?
<strike>My</strike> Her name is <strike>Greg.</strike> Margaret.
Apple, Banana, Cherry
John met Jane.

Here is the macro itself:<font face=Courier New><SPAN style="color:#00007F">Option</SPAN><SPAN style="color:#00007F">Explicit</SPAN><SPAN style="color:#007F00">'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯</SPAN><SPAN style="color:#00007F">Sub</SPAN> CompareText()<SPAN style="color:#007F00">'________________</SPAN><SPAN style="color:#007F00">' Greg Truby - Feb 2005</SPAN><SPAN style="color:#007F00">' Compare two columns of text.  Mark deletions and</SPAN><SPAN style="color:#007F00">' insertions between the text of each column.</SPAN><SPAN style="color:#007F00">' _________________________________________________</SPAN>

    <SPAN style="color:#00007F">Dim</SPAN> wsScratch<SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> rngOld<SPAN style="color:#00007F">As</SPAN> Range, rngNew<SPAN style="color:#00007F">As</SPAN> Range, _
        rngSentence<SPAN style="color:#00007F">As</SPAN> Range, rngWord<SPAN style="color:#00007F">As</SPAN> Range, _
        rngSentOld<SPAN style="color:#00007F">As</SPAN> Range, rngSentNew<SPAN style="color:#00007F">As</SPAN> Range, _
        rngWordNewLast<SPAN style="color:#00007F">As</SPAN> Range, rngFoundNew<SPAN style="color:#00007F">As</SPAN> Range, _
        rngWhereToInsert<SPAN style="color:#00007F">As</SPAN> Range, rngCurrent<SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Dim</SPAN> varSentenceOld<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>, varSentenceNew<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> strSentenceNew<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> i%, intStart<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN>, intLen<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> booStrike<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Boolean</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> lngUnderline<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>, lngColorIndex<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>
    
    <SPAN style="color:#007F00">' If chart or shape selected, leave.</SPAN>
    <SPAN style="color:#00007F">If</SPAN> TypeName(Selection)<> "Range"<SPAN style="color:#00007F">Then</SPAN><SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#007F00">' If no range selected, select current region of A1.</SPAN>
    <SPAN style="color:#00007F">If</SPAN> Selection.Count = 1<SPAN style="color:#00007F">Then</SPAN> [A1].CurrentRegion.Select
    
    <SPAN style="color:#007F00">' Old text assumed to be in column 1</SPAN>
    <SPAN style="color:#007F00">' New text assumed to be in column 2</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rngOld = Selection.Columns(1)
    <SPAN style="color:#00007F">Set</SPAN> rngNew = Selection.Columns(2)
    
    [A1].Select
    <SPAN style="color:#007F00">' Add a new scratch-pad worksheet</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> wsScratch = Worksheets.Add
    wsScratch.Name = "Scratch"
    
    <SPAN style="color:#007F00">' Step through each sentence in the old text.</SPAN>
    <SPAN style="color:#00007F">For</SPAN><SPAN style="color:#00007F">Each</SPAN> rngSentence<SPAN style="color:#00007F">In</SPAN> rngOld.Cells
        <SPAN style="color:#00007F">With</SPAN> rngSentence
            <SPAN style="color:#007F00">' remove an excess spaces</SPAN>
            .Value = WorksheetFunction.Trim(.Text)
            .Offset(, 1) = WorksheetFunction.Trim(.Offset(, 1).Text)
            <SPAN style="color:#007F00">' split into arrays, one word per array element</SPAN>
            varSentenceOld = Split(.Text, " ")
            varSentenceNew = Split(.Offset(, 1).Text, " ")
        <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
        <SPAN style="color:#007F00">' copy each array down columns 1 and 2 of scratch ws.</SPAN>
        <SPAN style="color:#00007F">For</SPAN> i =<SPAN style="color:#00007F">LBound</SPAN>(varSentenceOld)<SPAN style="color:#00007F">To</SPAN><SPAN style="color:#00007F">UBound</SPAN>(varSentenceOld)
            wsScratch.Cells(i + 1, 1) = varSentenceOld(i)
        <SPAN style="color:#00007F">Next</SPAN> i
        <SPAN style="color:#00007F">For</SPAN> i =<SPAN style="color:#00007F">LBound</SPAN>(varSentenceNew)<SPAN style="color:#00007F">To</SPAN><SPAN style="color:#00007F">UBound</SPAN>(varSentenceNew)
            wsScratch.Cells(i + 1, 2) = varSentenceNew(i)
        <SPAN style="color:#00007F">Next</SPAN> i
        <SPAN style="color:#00007F">Set</SPAN> rngSentOld = wsScratch.Range("A1").Resize(UBound(varSentenceOld) + 1)
        <SPAN style="color:#00007F">Set</SPAN> rngSentNew = wsScratch.Range("B1").Resize(UBound(varSentenceNew) + 1)
        <SPAN style="color:#00007F">Set</SPAN> rngWordNewLast = rngSentNew.Cells(rngSentNew.Count)
        <SPAN style="color:#00007F">Set</SPAN> rngWhereToInsert = wsScratch.Range("B1")
        <SPAN style="color:#00007F">Set</SPAN> rngWord = wsScratch.Range("A1")
        <SPAN style="color:#007F00">' Step through each word in the old sentence. (column 1 of wsScratch)</SPAN>
        <SPAN style="color:#00007F">Do</SPAN><SPAN style="color:#00007F">Until</SPAN> rngWord = vbNullString
            <SPAN style="color:#007F00">' Look for same word in new sentence.</SPAN>
            <SPAN style="color:#007F00">' Note - this is not case sensitive. To make case sensitive</SPAN>
            <SPAN style="color:#007F00">'        use named arg in Find() below.</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> rngFoundNew = rngSentNew.Find(rngWord)
            <SPAN style="color:#00007F">If</SPAN> rngFoundNew<SPAN style="color:#00007F">Is</SPAN><SPAN style="color:#00007F">Nothing</SPAN><SPAN style="color:#00007F">Then</SPAN>
                <SPAN style="color:#007F00">' Old word not in new sentence, scoot new words down</SPAN>
                rngWhereToInsert.Insert Shift:=xlDown
            <SPAN style="color:#00007F">Else</SPAN>
                <SPAN style="color:#00007F">If</SPAN> rngWord.Row > rngFoundNew.Row<SPAN style="color:#00007F">Then</SPAN>
                    <SPAN style="color:#007F00">' Should not happen - so stop</SPAN>
                    Stop
                <SPAN style="color:#00007F">ElseIf</SPAN> rngWord.Row< rngFoundNew.Row<SPAN style="color:#00007F">Then</SPAN>
                    <SPAN style="color:#007F00">' Scoot words in old sentence down until re-aligned on matching word.</SPAN>
                    rngWord.Resize(rngFoundNew.Row - rngWord.Row).Insert Shift:=xlDown
                <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
                <SPAN style="color:#007F00">' Place insertion (scooting) point below last found word.</SPAN>
                <SPAN style="color:#007F00">' Shrink range being looked through to rest of new sentence.</SPAN>
                <SPAN style="color:#00007F">Set</SPAN> rngWhereToInsert = rngFoundNew.Offset(1)
                <SPAN style="color:#00007F">Set</SPAN> rngSentNew = wsScratch.Range(rngWhereToInsert, rngWordNewLast)
            <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> rngFoundNew =<SPAN style="color:#00007F">Nothing</SPAN>
            <SPAN style="color:#007F00">' Move to next word in old sentence.</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> rngWord = rngWord.Offset(1)
        <SPAN style="color:#00007F">Loop</SPAN>
        <SPAN style="color:#00007F">Set</SPAN> rngWhereTo<SPAN style="color:#00007F">In</SPAN>sert = rngSentence.Offset(, 2)
        <SPAN style="color:#00007F">Set</SPAN> rngCurrent = wsScratch.Range("A1").CurrentRegion
        <SPAN style="color:#00007F">Set</SPAN> rngSentOld = rngCurrent.Columns(1)
        strSentenceNew = vbNullString
        <SPAN style="color:#007F00">' Create a new sentence that is a merging of the old and new sentences.</SPAN>
        <SPAN style="color:#00007F">For</SPAN><SPAN style="color:#00007F">Each</SPAN> rngWord In rngSentOld.Cells
            strSentenceNew = strSentenceNew & _
                             rngWord.Offset(, IIf(rngWord = vbNullString, 1, 0)) _
                             & " "
        <SPAN style="color:#00007F">Next</SPAN> rngWord
        <SPAN style="color:#007F00">' Trim off trailing space</SPAN>
        strSentenceNew = Left(strSentenceNew, Len(strSentenceNew) - 1)
        <SPAN style="color:#007F00">' Clear out the spot where the merged sentence will go and write in merged sentence.</SPAN>
        rngWhereTo<SPAN style="color:#00007F">In</SPAN>sert.Clear
        rngWhereToInsert = strSentenceNew
        intStart = 1
        <SPAN style="color:#007F00">' Run down column of words on scratch pad.</SPAN>
        <SPAN style="color:#007F00">' If match then normal format.  If in old column but not</SPAN>
        <SPAN style="color:#007F00">' new format as red, strikethrough.  <SPAN style="color:#00007F">If</SPAN> in new column but</SPAN>
        <SPAN style="color:#007F00">' not old column, format as blue, underlined.</SPAN>
        <SPAN style="color:#007F00">' Note - this is not case sensitive. To make case sensitive</SPAN>
        <SPAN style="color:#007F00">'        remove UCase from first comparison below.</SPAN>
        <SPAN style="color:#00007F">For</SPAN><SPAN style="color:#00007F">Each</SPAN> rngWord In rngSentOld.Cells
            If UCase(rngWord) = UCase(rngWord.Offset(, 1))<SPAN style="color:#00007F">Then</SPAN>        <SPAN style="color:#007F00">' same word in both sentences.</SPAN>
                booStrike =<SPAN style="color:#00007F">False</SPAN>
                lngUnderline = XlUnderlineStyle.xlUnderlineStyleNone
                lngColorIndex = xlAutomatic
                intLen = Len(rngWord)
            <SPAN style="color:#00007F">Else<SPAN style="color:#00007F">If</SPAN></SPAN> rngWord = vbNullString<SPAN style="color:#00007F">Then</SPAN>                          <SPAN style="color:#007F00">' new word</SPAN>
                booStrike =<SPAN style="color:#00007F">False</SPAN>
                lngUnderline = XlUnderlineStyle.xlUnderlineStyleSingle
                lngColorIndex = 5      <SPAN style="color:#007F00">' blue</SPAN>
                intLen = Len(rngWord.Offset(, 1))
            <SPAN style="color:#00007F">Else</SPAN>                                                        <SPAN style="color:#007F00">' deleted word</SPAN>
                booStrike =<SPAN style="color:#00007F">True</SPAN>
                lngUnderline = XlUnderlineStyle.xlUnderlineStyleNone
                lngColorIndex = 3      <SPAN style="color:#007F00">' red</SPAN>
                intLen = Len(rngWord)
            <SPAN style="color:#00007F">End</SPAN> If
            <SPAN style="color:#00007F">With</SPAN> rngWhereToInsert.Characters(Start:=intStart, Length:=intLen).Font
                .Strikethrough = booStrike
                .Underline = lngUnderline
                .ColorIndex = lngColorIndex
            <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
            intStart = intStart + intLen + 1
        <SPAN style="color:#00007F">Next</SPAN> rngWord
        <SPAN style="color:#007F00">' Erase scratch pad to prepare for next pair of sentences.</SPAN>
        wsScratch.Cells.Clear
    <SPAN style="color:#00007F">Next</SPAN> rngSentence
        
    Application.DisplayAlerts =<SPAN style="color:#00007F">False</SPAN>
    wsScratch.Delete
    Application.DisplayAlerts =<SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope this helps,

 

[PA HS Teacher]

Greg,
That's some pretty cool code. I can definitely see how that could be useful. I haven't had much time to play with it. I wonder if you had written some code in VBA, and you wanted to compate two versions of code that you had written, I suppose you could paste one version into one cell as text, and another into another cell as text, and the differences should jump right out. Thank you for posting.

 

[Greg Truby]

The thought had crossed my mind (using it to compare/reconcile two versions of code). Phase II, whenever I have time to fiddle with it some more? Right now I just use the document compare tool in Word whenever I have to do that particular chore.

 

[PA HS Teacher]

Greg,
This post has got me thinking. I've put together a list of Physics Questions I use in class (Once question per cell). I've written some code that allows me to filter out all questions that do not contain my search terms within the text of the question. I have code that puts the text of each question in comment for that cell.

I really like the way you formatted/colored etc, to make your changes stand out. I would like to format my search terms within the comment so that they stand out.

Is it possible to format specific words within a comment through code? For example, if I enter a search term of Incline and Friction, is there code that could make all instances of the word Incline or Friction, turn red within the comment?

I've tried recording a Macro of me formatting individual words within a comment, but nothing shows up in the code, but the recorded code includes nothing about the formatting of the Comment's text.

 

[PA HS Teacher]

Tom Urtis answered my question:
http://www.mrexcel.com/board2/viewtopic.php?p=625860#625860

Thank you for your help!

 

[javidc]

I have just found this excellent thread, and it goes quite some way to solving a problem I've had for the last few weeks regarding text comparisons of multiple columns and showing the differences between cells.

(Long story, but multiple word documents (up to 17, with approx 3,000 clauses to be considered), with subtle changes between some of them, all needing to be compared to a master and the differences marked for each document). Word has a compare documents facility, but it does not work very well with the documents we have as change tracking complicates things, so we extract the text and paste into excel and then align the text to section headings so that we can easily see the differences in individual sections, big changes are easy to see, but small ones are not). The alignment and text shifting is done using VBA and works well, but the differences are not easily seen - yet! )

I've run Greg's Macro and its outputs are subtly different to that described in his post. The red text is all on the left (data from each cell in column 1) and the blue text (data from each cell in column 2) follows it all on the right, if that makes sense, with no insertion points used showing deleted/inserted text.

I've done some tracing of the macro and have concluded that the split function is not working as intended in the macro. At least on my machine anyway. Excel 2003 SP1 on XP SP2 if that makes real difference. I have watched the Lbound and Ubound figures and they remain at zero for all strings processed by the macro, so no single words in each array element, just one long string.

I have used the split function example as given in
http://www.j-walk.com/ss/excel/tips/tip93.htm
and that works fine, splitting text nicely into separate array elements.

I thought initially that it was something to do with the "With rngSentence" line, but after removing that and working long-hand it still did not work. Does anyone have any ideas?

If someone could please confirm that copying the macro and running it obtains the desired result for them, that would be a good start. If it does, I'll be pleased, but very perplexed.

Excellent forum, I'm very pleased to say. I look forward to being able to contribute in the future. Thanks.

Javidc - Hampshire UK

 

[Greg Truby]

Looks like some of this got garbled when we made the transition over to the new board software. Here's a repost of the example data, example output and the code:

<TABLE style="WIDTH: 726pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=967 border=0><COLGROUP><COL style="WIDTH: 197pt; mso-width-source: userset; mso-width-alt: 9581" width=262><COL style="WIDTH: 166pt; mso-width-source: userset; mso-width-alt: 8082" width=221><COL style="WIDTH: 363pt; mso-width-source: userset; mso-width-alt: 17700" width=484><TBODY><TR style="HEIGHT: 15pt" height=20><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 197pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: silver" width=262 height=20>Old</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 166pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: silver" width=221>New</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 363pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: silver" width=484>Compared</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>An old sentence, my trusted old friend.</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">This is a new sentence, my friend.</TD><TD class=xl64 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"><S>An</S> <S>old</S> This is a new sentence, my <S>trusted</S> <S>old</S> friend.</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>This was an old sentence.</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">A new sentence.</TD><TD class=xl64 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"><S>This</S> <S>was</S> <S>an</S> <S>old</S> A new sentence.</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>The quick brown fox.</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">The quick red fox.</TD><TD class=xl65 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">The quick <S>brown</S> red fox.</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Bob, where are you?</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">Robert, where are you?</TD><TD class=xl64 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"><S>Bob,</S> Robert, where are you?</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>My name is Greg.</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">Her name is Margaret.</TD><TD class=xl64 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"><S>My</S> Her name is <S>Greg.</S> Margaret.</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Apple, Banana, Cherry</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">apple, banana, cherry</TD><TD class=xl65 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">Apple, Banana, Cherry</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>John</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">John met Jane.</TD><TD class=xl65 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">John met Jane.</TD></TR></TBODY></TABLE>

 

[Greg Truby]

Option Explicit
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Sub CompareText()
'________________
' Greg Truby - Feb 2005
' Compare two columns of text.**Mark deletions and
' insertions between the text of each column.
' _________________________________________________
    Dim wsScratch As Worksheet
    Dim rngOld As Range, rngNew As Range, _
        rngSentence As Range, rngWord As Range, _
        rngSentOld As Range, rngSentNew As Range, _
        rngWordNewLast As Range, rngFoundNew As Range, _
        rngWhereToInsert As Range, rngCurrent As Range
    Dim varSentenceOld As Variant, varSentenceNew As Variant
    Dim strSentenceNew As String
    Dim i%, intStart As Integer, intLen As Integer
    Dim booStrike As Boolean
    Dim lngUnderline As Long, lngColorIndex As Long
    
    ' If chart or shape selected, leave.
    If TypeName(Selection) <> "Range" Then Exit Sub
    ' If no range selected, select current region of A1.
    If Selection.Count = 1 Then [A1].CurrentRegion.Select
    
    ' Old text assumed to be in column 1
    ' New text assumed to be in column 2
    Set rngOld = Selection.Columns(1)
    Set rngNew = Selection.Columns(2)
    
    [A1].Select
    ' Add a new scratch-pad worksheet
    Set wsScratch = Worksheets.Add
    wsScratch.Name = "Scratch"
    
    ' Step through each sentence in the old text.
    For Each rngSentence In rngOld.Cells
        With rngSentence
            ' remove an excess spaces
            .Value = WorksheetFunction.Trim(.Text)
            .Offset(, 1) = WorksheetFunction.Trim(.Offset(, 1).Text)
            ' split into arrays, one word per array element
            varSentenceOld = Split(.Text, " ")
            varSentenceNew = Split(.Offset(, 1).Text, " ")
        End With
        ' copy each array down columns 1 and 2 of scratch ws.
        For i = LBound(varSentenceOld) To UBound(varSentenceOld)
            wsScratch.Cells(i + 1, 1) = varSentenceOld(i)
        Next i
        For i = LBound(varSentenceNew) To UBound(varSentenceNew)
            wsScratch.Cells(i + 1, 2) = varSentenceNew(i)
        Next i
        Set rngSentOld = wsScratch.Range("A1").Resize(UBound(varSentenceOld) + 1)
        Set rngSentNew = wsScratch.Range("B1").Resize(UBound(varSentenceNew) + 1)
        Set rngWordNewLast = rngSentNew.Cells(rngSentNew.Count)
        Set rngWhereToInsert = wsScratch.Range("B1")
        Set rngWord = wsScratch.Range("A1")
        ' Step through each word in the old sentence. (column 1 of wsScratch)
        Do Until rngWord = vbNullString
            ' Look for same word in new sentence.
            ' Note - this is not case sensitive. To make case sensitive
            '        use named arg in Find() below.
            Set rngFoundNew = rngSentNew.Find(rngWord)
            If rngFoundNew Is Nothing Then
                ' Old word not in new sentence, scoot new words down
                rngWhereToInsert.Insert Shift:=xlDown
            Else
                If rngWord.Row > rngFoundNew.Row Then
                    ' Should not happen - so stop
                    Stop
                ElseIf rngWord.Row < rngFoundNew.Row Then
                    ' Scoot words in old sentence down until re-aligned on matching word.
                    rngWord.Resize(rngFoundNew.Row - rngWord.Row).Insert Shift:=xlDown
                End If
                ' Place insertion (scooting) point below last found word.
                ' Shrink range being looked through to rest of new sentence.
                Set rngWhereToInsert = rngFoundNew.Offset(1)
                Set rngSentNew = wsScratch.Range(rngWhereToInsert, rngWordNewLast)
            End If
            Set rngFoundNew = Nothing
            ' Move to next word in old sentence.
            Set rngWord = rngWord.Offset(1)
        Loop
        Set rngWhereToInsert = rngSentence.Offset(, 2)
        Set rngCurrent = wsScratch.Range("A1").CurrentRegion
        Set rngSentOld = rngCurrent.Columns(1)
        strSentenceNew = vbNullString
        ' Create a new sentence that is a merging of the old and new sentences.
        For Each rngWord In rngSentOld.Cells
            strSentenceNew = strSentenceNew & _
                             rngWord.Offset(, IIf(rngWord = vbNullString, 1, 0)) _
                             & " "
        Next rngWord
        ' Trim off trailing space
        strSentenceNew = Left(strSentenceNew, Len(strSentenceNew) - 1)
        ' Clear out the spot where the merged sentence will go and write in merged sentence.
        rngWhereToInsert.Clear
        rngWhereToInsert = strSentenceNew
        intStart = 1
        ' Run down column of words on scratch pad.
        ' If match then normal format.**If in old column but not
        ' new format as red, strikethrough.**If in new column but
        ' not old column, format as blue, underlined.
        ' Note - this is not case sensitive. To make case sensitive
        '        remove UCase from first comparison below.
        For Each rngWord In rngSentOld.Cells
            If UCase(rngWord) = UCase(rngWord.Offset(, 1)) Then         ' same word in both sentences.
                booStrike = False
                lngUnderline = XlUnderlineStyle.xlUnderlineStyleNone
                lngColorIndex = xlAutomatic
                intLen = Len(rngWord)
            ElseIf rngWord = vbNullString Then                          ' new word
                booStrike = False
                lngUnderline = XlUnderlineStyle.xlUnderlineStyleSingle
                lngColorIndex = 5                                       ' blue
                intLen = Len(rngWord.Offset(, 1))
            Else                                                        ' deleted word
                booStrike = True
                lngUnderline = XlUnderlineStyle.xlUnderlineStyleNone
                lngColorIndex = 3                                       ' red
                intLen = Len(rngWord)
            End If
            With rngWhereToInsert.Characters(Start:=intStart, Length:=intLen).Font
                .Strikethrough = booStrike
                .Underline = lngUnderline
                .ColorIndex = lngColorIndex
            End With
            intStart = intStart + intLen + 1
        Next rngWord
        ' Erase scratch pad to prepare for next pair of sentences.
        wsScratch.Cells.Clear
    Next rngSentence
        
    Application.DisplayAlerts = False
    wsScratch.Delete
    Application.DisplayAlerts = True
    
End Sub