Is everything in the text in the cell using the same font?

Question

I work with some Excel files, which usually contain a lot of text inside cells. I would like to run a check so that all the text is in the same font (specifically Calibri).

At the moment, I have such a way to do this. But it works very slowly.

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 am looking for a specific character, then it works fine. Be that as it may, my current macro may take a few seconds and sometimes crashes.

I am wondering if anyone can offer a better alternative.

Answer 1

, Range Font.Name:

• Range ,

• Range , , Null

:

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

,

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

:

MsgBox fnFontCheck(Selection, "Calibri")

Answer 2

, , Select :

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