VBA Compare two strings, highlight differences

cgmojoco

cgmojoco

Well-known Member
Joined
Jan 15, 2005
Messages
699
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>
 
Sort by date Sort by votes
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...
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
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.

Code: 
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
 
Upvote 0
The trick was not to highlight the differences, but to make the whole cell red and then make the similarities black.
 
Upvote 0
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:
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
 
Last edited:
Upvote 0
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
Code: 
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
 
Upvote 0
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.
 
Upvote 0
Untested, but I think that adding this to Sub highlightDifferences might do what you want
Code: 
    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
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
817
gvsumich
G
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
384
AndyEd
A
A
  • Locked
  • Question
values across tables found by name
Replies
2
Views
376
Fluff
Fluff
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C

Forum statistics

Threads
1,214,647
Messages
6,120,722
Members
448,987
Latest member
marion_davis

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top