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