Count words in a Microsoft Word document by font?

Question

I have a large document with code samples in. I want to know the word count for all text in font Calibri (Body), regardless of size. I want to ignore Consolas etc.

I have a macro that counts by italic (posted as an example) but can't get it to run.

Sub IgnoreItalics()
    Dim lngWord As Long, lngCountIt As Long

    lngCountIt = 0

    For lngWord = 1 To ActiveDocument.Words.Count
        If ActiveDocument.Words(lngWord).Italic Then
            lngCountIt = lngCountIt + 1
        End If
    Next lngWord

    MsgBox "Number of non-italic words: " & _
    ActiveDocument.BuiltInDocumentProperties("Number of words") -
    lngCountIt
End Sub

Any idea how to change this to Consolas?

What doesn't run about this? Are you getting an error, an invalid result, etc? — Gaffi
I think it may have been the document, it is 31k words long so last time it crashed under my environment, thought it may have been the code. — Ben Taliadoros
Interesting. In your code you use both ActiveDocument.Words.Count and ActiveDocument.BuiltInDocumentProperties("Number of words"). Have you tried using just on or the other in both positions? — Gaffi

Lunatik Lunatik · Accepted Answer · 2012-03-15T14:01:50

Modifying your code so you can hopefully understand it, here is a solution that works for me

Sub CountTypeface()
    Dim lngWord As Long
    Dim lngCountIt As Long
    Const Typeface As String = "Calibri"

    For lngWord = 1 To ActiveDocument.Words.Count
        'Ignore any document "Words" that aren't real words (CR, LF etc)
        If Len(Trim(ActiveDocument.Words(lngWord))) > 1 Then
            If ActiveDocument.Words(lngWord).Font.Name = Typeface Then
                lngCountIt = lngCountIt + 1
            End If
        End If
    Next lngWord

    MsgBox "Number of " & Typeface & " words: " & lngCountIt
End Sub

Count words in a Microsoft Word document by font?

3 Answers