Does all the text in cell use the same font?

Question

I'm working with some Excel files that typically have lots of text inside cells. I'd like to run a check to ensure that all the text is the same font (specifically, Calibri).

At the moment, I have this way of doing it. But it runs extremely slow.

Function fnCalibriCheck() As String

Dim CurrentCell As Range                                ' The current cell that is being checked
Dim SelectedRng As Range                                ' The selection range
Dim F As Long
Set SelectedRng = ActiveSheet.Range(Selection.Address)  ' Defines the selection range

For Each CurrentCell In SelectedRng                     ' Goes through every cell in the selection and performs the check

    For F = 1 To Len(CurrentCell)
        If CurrentCell.Characters(F, 1).font.Name <> "Calibri" Then
            fnCalibriCheck = "not calibri"
        End If
    Next

Next
End Function

The problem seems to be specific to the Font.Name property. For example, if I run the same code, but instead of Font.Name I search for a specific character, then it runs perfectly fine. As it is though, my current macro can take several seconds to run, and occasionally crashes.

I'm wondering if anyone can suggest a better alternative.

Answer 1

you can speed it up considerably by exploiting the following behavior of a Range Font.Name property:

• if all characters of all cells in the range have the same font then it returns that font name

• if any characters of any cell in the range has a different font than any other character of any other cell then it returns Null

so you can simply code:

Function fnCalibriCheck() As String
    If IsNull(Selection.Font.Name = "Calibri") Then fnCalibriCheck = "not Calibri"
End Function

which you can make a little more general by accepting the range to scan and the font to check as parameters

Function fnFontCheck(rng As Range, fontName As String) As String
    If IsNull(rng.Font.Name = fontName) Then fnFontCheck = "not " & fontName
End Function

and which could be called like follows:

MsgBox fnFontCheck(Selection, "Calibri")

Answer 2

You might get a slight speed improvement by passing the range rather than using Select and immediately returning on the first failure:

Function fnCalibriCheck(SelectedRng As Range) As String

    Dim CurrentCell As Range
    Dim F As Long

    fnCalibriCheck = "calibri"
    For Each CurrentCell In SelectedRng
        If CurrentCell.Value <> "" Then
            For F = 1 To Len(CurrentCell)
                If CurrentCell.Characters(F, 1).Font.Name <> "Calibri" Then
                    fnCalibriCheck = "not calibri"
                    Exit Function
                End If
            Next
        End If
    Next
End Function