Search code examples
excelvba

Highlight differences by changing specific characters to a different color, using Range.Characters.Font

I am trying to compare the text in two columns and highlight differences by changing specific characters to a different color, using the Range.Characters.Font object property.

The color formatting code seems to break whenever the cells being formatted include numbers.

Here’s the code I’m using to set the character formatting:

If foundPos > 0 Then
    If typeFlag = True Then  'Mark text red for True flag, blue for False flag
        xCell.Characters(foundPos, Len(subStr)).Font.Color = vbRed
    Else
        xCell.Characters(foundPos, Len(subStr)).Font.Color = vbBlue
    End If
End If

The goal is to highlight only those characters which are different by specifying the starting position foundPos and number of characters to change Len(subStr).

With ordinary strings this works.

When numbers are involved, like the examples below, the code will only change the text color if the starting position is 1, and even then it will only change the color of all characters in the cell regardless what is specified for length.
If the starting position is anything other than 1, the text doesn’t change color at all.

At first I thought this might be because the cell is formatted as a number, but xCell.NumberFormat = "@" to convert it to text before trying to set the color did not change the behavior.
I observe the same behavior when trying to modify any other .Font attribute, like Bold or Italics.
The numbers in the cells are hand-typed, not formulas.

I reviewed other questions on Stack Exchange discussing the Range.Characters property, but none that I found specifically address an issue changing the color of a subset of digits within a number cell.

Example Output

Solution

  • Interesting, I would add ' at the beginning of a cell. The .NumberFormat = "@" seems affect the formatting of the cell only, not how Excel treats its contents. Check code below:

    Sub Highlight_Main()
    Dim lastRow As Long
    lastRow = GetLastRow()
    
    Dim i As Long
    For i = 1 To lastRow
        ProcessCells i
    Next i
End Sub

Function GetLastRow() As Long
    GetLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row
End Function

Sub ProcessCells(ByVal row As Long)
    Dim cellA As Range, cellB As Range
    Set cellA = ActiveSheet.Cells(row, 1)
    Set cellB = ActiveSheet.Cells(row, 2)
    
    PrepareCell cellA
    PrepareCell cellB
    
    ColorDifference cellA, cellB, vbRed
    ColorDifference cellB, cellA, vbBlue
End Sub

Sub PrepareCell(ByRef cell As Range)
    If IsNumeric(cell.Text) Then cell.Value = "'" & cell.Text
    cell.Characters.Font.color = vbBlack
End Sub

Sub ColorDifference(ByRef mainCell As Range, ByRef compareCell As Range, ByVal color As Long)
    Dim i As Long, foundPos As Long
    For i = 1 To Len(mainCell.Text)
        If i > Len(compareCell.Text) Or Mid(mainCell.Text, i, 1) <> Mid(compareCell.Text, i, 1) Then
            foundPos = i
            mainCell.Characters(foundPos, 1).Font.color = color
        End If
    Next i
End Sub