PDA

View Full Version : VBA Compare Cells in a Table and Highlight Word Differences



escobarjr
07-24-2013, 05:31 PM
Hi guys,

I'm trying to create a macro that has multiple paragraphs in each cell. I wanted to see if anyone could help me build a macro that simply highlights the differences between between the first cell in the row with the others in the same row. So I have an original paragraph and the remaining cells in the same row as the original well be compared the it. can anyone help me do this? I've been pulling my hair trying to figure it out, but this is beyond me.

Thanks

escobarjr
07-25-2013, 09:41 AM
The document shows what I want. I've attached the code I have.
10327


Sub CompareParagraphs()


Dim FirstPara As Range
Dim OtherPara As Range
Dim iP1 As Integer
Dim iP2 As Integer
Dim S1 As String
Dim S2 As String


S1 = InputBox("Enter number of first paragraph to check")


If StrPtr(S1) = 0 Then
' user cancelled.
GoTo Cancelled0:
Else
If Len(S1) = 0 Then
'user Pressed OK, but there was no entry in the input control
GoTo Cancelled0:
Else
'User pressed OK and there was something in the input control
iP1 = S1
End If
End If
S2 = InputBox("Enter number of the paragraph to compare")


If StrPtr(S2) = 0 Then
' user cancelled.
GoTo Cancelled0:
Else
If Len(S2) = 0 Then
'user Pressed OK, but there was no entry in the input control
GoTo Cancelled0:
Else
'User pressed OK and there was something in the input control
iP2 = S2
End If
End If
Set FirstPara = ActiveDocument.Paragraphs(iP1).Range
Set OtherPara = ActiveDocument.Paragraphs(iP2).Range
If FirstPara.Text = OtherPara.Text Then
MsgBox "Paragraphs are the same", vbInformation, _
"Compare paragraphs"
Else
If FirstPara.Text > OtherPara.Text Then
For i = 1 To FirstPara.Characters.Count
If FirstPara.Characters(i) <> OtherPara.Characters(i) Then
OtherPara.Characters(i).HighlightColorIndex = wdYellow


Exit For
End If
Next i
Else
For i = 1 To OtherPara.Characters.Count
If FirstPara.Characters(i) <> OtherPara.Characters(i) Then
OtherPara.Characters(i).HighlightColorIndex = wdYellow


Exit For
End If
Next i
End If
End If


Cancelled0:
Exit Sub
End Sub