VBA Compare two strings, highlight differences

[cgmojoco]

Hi there-

Example---how can I get the red highlighting to work like so?

<table x:str="" style="border-collapse: collapse; width: 187px; height: 90px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 42pt;" span="2" width="56"> <tbody><tr style="height: 11.25pt;" height="15"> <td style="height: 11.25pt; width: 42pt;" width="56" height="15">Test</td> <td style="width: 42pt;" width="56">Test_002</td> </tr> <tr style="height: 11.25pt;" height="15"> <td class="xl22" style="background: silver none repeat scroll 0% 0%; height: 11.25pt; -moz-background-clip: -moz-initial; -moz-background-origin: -moz-initial; -moz-background-inline-policy: -moz-initial;" height="15">6698F</td> <td class="xl23" style="background: silver none repeat scroll 0% 0%; -moz-background-clip: -moz-initial; -moz-background-origin: -moz-initial; -moz-background-inline-policy: -moz-initial;">ES6698F</td> </tr> <tr style="height: 11.25pt;" height="15"> <td class="xl22" style="height: 11.25pt;" height="15">DVP3142</td> <td class="xl22">DVP3144</td> </tr> <tr style="height: 11.25pt;" height="15"> <td class="xl22" style="background: silver none repeat scroll 0% 0%; height: 11.25pt; -moz-background-clip: -moz-initial; -moz-background-origin: -moz-initial; -moz-background-inline-policy: -moz-initial;" height="15">GTM8800</td> <td class="xl22" style="background: silver none repeat scroll 0% 0%; -moz-background-clip: -moz-initial; -moz-background-origin: -moz-initial; -moz-background-inline-policy: -moz-initial;">GTI8000</td> </tr> <tr style="height: 11.25pt;" height="15"> <td class="xl22" style="height: 11.25pt;" height="15">SDV394</td> <td class="xl22">SV384STC</td> </tr> </tbody></table>

 

[cgmojoco]

Just wondering, if there is anything else I need to describe.
I don't mean to trouble anyone, I thought maybe the solution already existed but I can't seem to find it via google or searching this site...

 

[mikerickson]

I think that this might do what you want. Put this in a normal module, adjust the line in CheckAgainstColumnA to make the sheet name's match and run CheckAgainstColumnA.

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

Sub CheckAgainstColumnA()
    Dim oneCell As Range
    With ThisWorkbook.Sheets("Sheet1").Range("A:A"): Rem adjust
        For Each oneCell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            oneCell.Font.Color = blackCIndex
            oneCell.Offset(0, 1).Font.ColorIndex = blackCIndex
            Call highlightDifference(oneCell, oneCell.Offset(0, 1))
            Call highlightDifference(oneCell.Offset(0, 1), oneCell)
        Next oneCell
    End With
End Sub

Sub highlightDifference(refCell As Range, testCell As Range)
    Dim refString As String, testString As String
    Dim i As Long, startPoint As Long, newPoint As Long
    
    testCell.Font.ColorIndex = redCIndex
    
    refString = refCell.Text
    testString = testCell.Text
    startPoint = 1
    For i = 1 To Len(refString)
        newPoint = InStr(startPoint, testString, Mid(refString, i, 1))
        If newPoint <> 0 Then
            testCell.Characters(newPoint, 1).Font.ColorIndex = blackCIndex
            startPoint = newPoint + 1
        End If
    Next i
End Sub

 

[cgmojoco]

ray:
Excellent!!!!!!!!!!!!!!!!!!!!!

 

[mikerickson]

The trick was not to highlight the differences, but to make the whole cell red and then make the similarities black.

 

[cgmojoco]

I did get an error on the sheet part so I just changed to activesheet.

 

[cgmojoco]

Couple of requests to functionality.

Ability to turn case sensitive on/off.

To change the font more than just red I've just added some modest adjustments to your wonderful code:

Sub highlightDifference(refCell As Range, testCell As Range)
    Dim refString As String, testString As String
    Dim i As Long, startPoint As Long, newPoint As Long
    
    
    With testCell.Font
    .ColorIndex = redCIndex
    .FontStyle = "Bold"
    End With
     
    refString = refCell.Text
    testString = testCell.Text
    startPoint = 1
    For i = 1 To Len(refString)
        newPoint = InStr(startPoint, testString, Mid(refString, i, 1))
        If newPoint <> 0 Then
        With testCell.Characters(newPoint, 1).Font
        .ColorIndex = blackCIndex
        .FontStyle = "Regular"
        End With
            startPoint = newPoint + 1
        End If
    Next i

End Sub

 

[mikerickson]

This adds a CaseSensitivity argument to the highlightDifference sub.
To make all string operations in the module case insensitive, un-comment out the Option Compare Text

Option Explicit
'Option Compare Text

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

Sub CheckAgainstColumnA()
    Dim CSensitivity As Long
    Dim oneCell As Range
    Select Case MsgBox("Case Sensitive", vbYesNo)
        Case Is = vbCancel
            Exit Sub
        Case Is = vbYes
            CSensitivity = 0
        Case Is = vbNo
            CSensitivity = 1
    End Select
    
    With ThisWorkbook.Sheets("Sheet1").Range("A:A"): Rem adjust
        For Each oneCell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            oneCell.Font.Color = blackCIndex
            oneCell.Offset(0, 1).Font.ColorIndex = blackCIndex
            Call highlightDifference(oneCell, oneCell.Offset(0, 1), CSensitivity)
            Call highlightDifference(oneCell.Offset(0, 1), oneCell, CSensitivity)
        Next oneCell
    End With
End Sub



Sub highlightDifference(refCell As Range, testCell As Range, Optional CaseSensitivity As Long)
    Rem default caseSenstivity = 0 for case insensitive, set CaseSensitivity = 1
    
    Dim refString As String, testString As String
    Dim i As Long, startPoint As Long, newPoint As Long
    

    CaseSensitivity = Sgn(CaseSensitivity) ^ 2
    
    
    With testCell.Font
        .ColorIndex = redCIndex
        .FontStyle = "Bold"
    End With
     
    refString = refCell.Text
    testString = testCell.Text
    startPoint = 1
    For i = 1 To Len(refString)
        newPoint = InStr(startPoint, testString, Mid(refString, i, 1), CaseSensitivity)
        If newPoint <> 0 Then
            With testCell.Characters(newPoint, 1).Font
                .ColorIndex = blackCIndex
                .FontStyle = "Regular"
            End With
            startPoint = newPoint + 1
        End If
    Next i

End Sub

 

[pawanhsharma]

I have used this code and it work fine if the text matches from both the colomns but is it possible to avoid spaces and enter as the data what we compare have lots of codes and text which is been copied from other word documents so containing enter as well.

 

[mikerickson]

Untested, but I think that adding this to Sub highlightDifferences might do what you want

    For i = 1 To Len(refString)
        newPoint = InStr(startPoint, testString, Mid(refString, i, 1), CaseSensitivity)

        [COLOR="#FF0000"]Select Case Asc(Mid(refString,i,1))
            Case 32, 10, 13
            newPoint = 0
        End Select[/COLOR]
        If newPoint <> 0 Then
            With testCell.Characters(newPoint, 1).Font
                .ColorIndex = blackCIndex
                .FontStyle = "Regular"
            End With
            startPoint = newPoint + 1
        End If
    Next i

 

[CChandl]

Hello, I used this code and it works, but I'm getting mixed results. Sometime it hightlight the correct digit, other times it highlights up to four digits following the first incorrect digit. I'm applying the code to text formated cells with contain 10 digits (telephone numbers). It would be great to have it work with a phone number format and still hightlight the errors.