Locating differences in text when comparing two cells

[Christine]

I have two columns of cells. One thousand rows. Every cell has a long text entry in it (around 500 to 900 characters). Each row (of 2 cells) containswhat looks like exactly the same text, but there IS minor differences. How can I cleverly get an output from Excel to bring to my attention what thedifferences are without me having to read each cell and compare it with it's neighbour. The ideal output would be akin to a word markup of redstrikeout and blue insert - but that is a dream result which I cannot think is achieveable. Is there another way. Many thanks. Christine.

 

[Claus Busch]

Hi Christine,

Am Tue, 22 Oct 2013 05:36:49 -0700 (PDT) schrieb Christine:

I have two columns of cells. One thousand rows. Every cell has a long text entry in it (around 500 to 900 characters). Each row (of 2 cells) contains what looks like exactly the same text, but there IS minor differences. How can I cleverly get an output from Excel to bring to my attention what the differences are without me having to read each cell and compare it with it's neighbour. The ideal output would be akin to a word markup of redstrikeout and blue insert - but that is a dream result which I cannot think is achieveable. Is there another way. Many thanks. Christine.

the correct spelling in column A and test for column B:

Sub Test()
Dim LRow As Long
Dim rngC As Range
Dim i As Integer

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
For i = 1 To Len(rngC)
With rngC.Offset(, 1).Characters(i, 1)
If Mid(rngC, i, 1) <> Mid(rngC.Offset(, 1), i, 1) Then
.Font.ColorIndex = 3
End If
End With
Next
Next

End Sub


Regards
Claus B.

 

[Claus Busch]

Hi Christine,

Am Tue, 22 Oct 2013 15:13:13 +0200 schrieb Claus Busch:

the correct spelling in column A and test for column B:

a bit faster:

Sub Test2()
Dim LRow As Long
Dim rngC As Range
Dim i As Integer
Dim var1 As Variant
Dim var2 As Variant
Dim Start As Integer
Dim myLen As Integer

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
var1 = Split(rngC, " ")
var2 = Split(rngC.Offset(, 1), " ")
For i = LBound(var1) To UBound(var1)
If var1(i) <> var2(i) Then
Start = InStr(rngC.Offset(, 1), var2(i))
myLen = Len(var2(i))
With rngC.Offset(, 1).Characters(Start, myLen)
.Font.ColorIndex = 3
End With
End If
Next
Next
End Sub


Regards
Claus B.

 

[Christine]

I have two columns of cells. One thousand rows. Every cell has a long text entry in it (around 500 to 900 characters). Each row (of 2 cells) contains what looks like exactly the same text, but there IS minor differences. How can I cleverly get an output from Excel to bring to my attention what the differences are without me having to read each cell and compare it with it's neighbour. The ideal output would be akin to a word markup of redstrikeout and blue insert - but that is a dream result which I cannot think is achieveable. Is there another way. Many thanks. Christine.

Claus - thanks. Just wondering how to implement your solution. I am very comfortable putting formulae in beginning with "=". Not sure about the ?visual basic? Thanks, Christine

 

[Claus Busch]

Hi Christine,

Am Tue, 22 Oct 2013 06:36:30 -0700 (PDT) schrieb Christine:

Claus - thanks. Just wondering how to implement your solution. I am very comfortable putting formulae in beginning with "=". Not sure about the ?visual basic? Thanks, Christine

press Alt+F11. In editor insert a module and paste the code in that
module.


Regards
Claus B.

 

[Christine]

Hi Christine,



Am Tue, 22 Oct 2013 06:36:30 -0700 (PDT) schrieb Christine:






press Alt+F11. In editor insert a module and paste the code in that

module.





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Hi Claus - I have my data in column H and column L. How do I adjust your script to make that work? Thanks, Christine

 

[Claus Busch]

Hi Christine,

Am Tue, 22 Oct 2013 10:22:55 -0700 (PDT) schrieb Christine:

I have my data in column H and column L. How do I adjust your script to make that work?

please have a look here:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for the workbook "TextCompare"
Rightclick and download it because macros are disabled in SkyDrive.
There is a little text from Wikipedia in it. In L1 I built in three
errors. Select L1 and switch font color to automatic. Then run the macro
"Test" and see how the errors will be colored.


Regards
Claus B.

 

[Christine]

Hi Christine,



Am Tue, 22 Oct 2013 10:22:55 -0700 (PDT) schrieb Christine:






please have a look here:

https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326

for the workbook "TextCompare"

Rightclick and download it because macros are disabled in SkyDrive.

There is a little text from Wikipedia in it. In L1 I built in three

errors. Select L1 and switch font color to automatic. Then run the macro

"Test" and see how the errors will be colored.





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Hi Claus, did all that and I could see the red font. However, when I put the code into my spreadsheet it didnt seem to work. I was presented with a "subscript out of range" box

 

[Claus Busch]

Hi Christine,

Am Tue, 22 Oct 2013 10:57:37 -0700 (PDT) schrieb Christine:

Hi Claus, did all that and I could see the red font. However, when I put the code into my spreadsheet it didnt seem to work. I was presented with a "subscript out of range" box

did you insert a standard module and paste the code in?
Do you have different count of cells in H and L?
Can you upload the file and post the link here?
You could also send it on my address.


Regards
Claus B.

 

[John Jones]

On Tue, 22 Oct 2013 15:26:45 +0200, "Claus Busch" <claus_busch@t-

Hi Christine,

Am Tue, 22 Oct 2013 15:13:13 +0200 schrieb Claus Busch:


a bit faster:

Sub Test2()
snip
Regards
Claus B.

Hi Claus
This is good. But I wanted the marking on each of the cells, also
there are features I wanted to change: if the wrong word is a repeated
word then the hilight doesnt work, test4 below. And if the number of
words are different then not all is captured - tests 2, 3.


tests:
1 this is an elephant this isnt an elefant

2 i wondered lonely as a clewd i wandered lonely as a cloud
that drifts

3 i wandered lonely as a cloud that drifts i wondered lonely as a
clewd

4 i wandered lonely as a cloud that drifts i wandered wandered as a
cloud that drifts

5 a test of spaces a test of spaces what


For my purpose I used a finite state approach in a character by
character loop. V inefficient. The resulting lengthy macro follows my
sig.

To use select the cells in a column. It compares the cells immediately
to the right and marks *both*, synchronising on spaces.
Of course the full monty, synchronising when there are sufficiently long
correct strings would be the equivalent of using ExamDiff and I believe
that to be quite a hard problem.

BTW the "maxloop" in the code is because I am unable (MSW7HP + Excel
2010)to stop screaming or indeed any loops using pause/break, so I build
this into every loop.

HTH
JJ

'***********************************************************
' Purpose: compares selected column with its neighbour
' to the right and hilights differences.
'
'***********************************************************
Sub compSelection()

Dim rngC As Range
Dim i As Integer, j As Integer
Dim st As Integer ' state no
Dim mxi As Integer, mxj As Integer
Dim var1 As Variant
Dim var2 As Variant
Dim maxloop As Integer


For Each rngC In Selection
var1 = rngC.Text
var2 = rngC.Offset(, 1).Text
i = 1 ' index to var1
j = 1 ' index to var2
st = 0
mxi = Len(var1)
mxj = Len(var2)
maxloop = 10000

Do
maxloop = maxloop - 1
If (i > mxi) And (j > mxj) Then
st = -1
Else
If (i > mxi) Then
st = 5
End If
If (j > mxj) Then
st = 4
End If
End If

Select Case st
Case 0: ' loop while strings are identical

If Mid(var1, i, 1) = Mid(var2, j, 1) Then
If Mid(var1, i, 1) = " " Then st = 1 ' both spaces
i = i + 1
j = j + 1
Else
st = 2
End If

Case 1: ' synchronising on nonspace part 1
If Mid(var1, i, 1) <> " " Then
st = 10
Else
i = i + 1
End If

Case 10: ' synchronising on nonspace part 2
If Mid(var2, j, 1) <> " " Then
st = 0
Else
j = j + 1
End If

Case 2: ' hilighting string 1 to next space
If Mid(var1, i, 1) = " " Then
st = 3
Else
rngC.Characters(i, 1).Font.ColorIndex = 3
i = i + 1
End If

Case 3: ' hilighting string 2 to next space
If Mid(var2, j, 1) = " " Then
st = 1
Else
rngC.Offset(, 1).Characters(j, 1).Font.ColorIndex = 3
j = j + 1
End If

Case 4: ' hilighting string 1 to end
rngC.Characters(i, 1).Font.ColorIndex = 3
i = i + 1


Case 5: ' hilighting string 2 to end
rngC.Offset(, 1).Characters(j, 1).Font.ColorIndex = 3
j = j + 1

End Select

Loop While (st <> -1) And (maxloop > 0)

Next
End Sub

 

[Christine]

John Jones - many thanks. Fantastic. All done.
Christine