# Comparing text in cells

#### NJActuary

##### New Member
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.

### Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Here's a user defined function I made that should do the trick,

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

Code:
``````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
ABCD
1HiBob,howareyou?HiSteve,Howareyou?Steve,Howareyo
3HiBob,howareyou?HiJoe,howareyou?Je
4MorningDaveMorningIrisIris
Sheet3

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
ABCD
1OldNewCompared
2Anoldsentence,mytrustedoldfriend.Thisisanewsentence,myfriend.AnoldThisisanewsentence,mytrustedoldfriend.
3Thiswasanoldsentence.Anewsentence.ThiswasanoldAnewsentence.
4Thequickbrownfox.Thequickredfox.Thequickbrownredfox.
5Bob,whereareyou?Robert,whereareyou?Bob,Robert,whereareyou?
6MynameisGreg.HernameisMargaret.MyHernameisGreg.Margaret.
7Apple,Banana,Cherryapple,banana,cherryApple,Banana,Cherry
8JohnJohnmetJane.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
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

wsScratch.Delete
<SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope this helps,

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.

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.

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.

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

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>

Code:
``````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
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

wsScratch.Delete

End Sub``````

Replies
4
Views
225
Replies
3
Views
945
Replies
5
Views
140
Replies
6
Views
668
Replies
4
Views
766

1,218,620
Messages
6,143,520
Members
450,492
Latest member
Rusbus1972

### 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.

### Which adblocker are you using?

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

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