Hello all,

I've been writing a VBA macro that compares the text in the current active cell to the text in the cell directly to the left and highlights in red all the new words it finds. I'm dealing with a worksheet where each cell contains a full paragraph of text. My code works reasonably well for most of the text, but when it compares two really long paragraphs it becomes soooo ssssllllllllloooooooowwwwww. It seems like it's the loop at the end that does the color changing that slows it down, but I don't know why. If anyone recognizes and can explain why it's so slow for larger blocks of text or could offer some way to speed it up, I would very much appreciate it. Other comments or improvements are welcome too.

Here's my code:

Sub Compare()

Const redCIndex As Long = 3
Const blackCIndex As Long = 0

Dim newString() As String, oldString() As String
Dim currPos As Long, matchPos() As Integer, matchLength() As Integer

newString = Split(ActiveCell.Value, " ")
oldString = Split(ActiveCell.Offset(0, -1).Value, " ")
currPos = 0
ReDim matchPos(0 To 0) As Integer
ReDim matchLength(0 To 0) As Integer
matchPos(0) = 0
matchLength(0) = 0

For i = 0 To UBound(newString)
    For j = 0 To UBound(oldString)
        If StrComp(newString(i), oldString(j), vbTextCompare) = 0 Then
            oldString(j) = "qqqqqqqq"
            ReDim Preserve matchPos(0 To UBound(matchPos) + 1) As Integer
            ReDim Preserve matchLength(0 To UBound(matchLength) + 1) As Integer
            matchPos(UBound(matchPos)) = currPos
            matchLength(UBound(matchLength)) = Len(newString(i)) + 1
            GoTo skipp
        End If
    Next j
skipp:
currPos = currPos + Len(newString(i)) + 1
Next i

ActiveCell.Font.ColorIndex = redCIndex
For i = 0 To UBound(matchLength)
    If matchLength(i) > 0 Then
        ActiveCell.Characters(matchPos(i), matchLength(i)).Font.ColorIndex = blackCIndex
        'MsgBox (matchPos(i))
        'MsgBox (matchLength(i))
    End If
Next i

End Sub