Count Number of Each Character in Word Document

Sub FindNumberOfEachCharacterInActiveDocument_SortedAlphabetically()
    
'=========================
'Macro created 2022 by Lene Fredborg, DocTools - www.thedoctools.com
'THIS MACRO IS COPYRIGHT. YOU ARE WELCOME TO USE THE MACRO BUT YOU MUST KEEP THE LINE ABOVE.
'YOU ARE NOT ALLOWED TO PUBLISH THE MACRO AS YOUR OWN, IN WHOLE OR IN PART.
'=========================
'The macro creates a list of the number of occurrences in the active document
'of each character in the list you specify.
'The macro checks the main text story only.
'The result is shown in a dialog box, listed in the character order you specify.
'=========================
    
    Dim strText As String
    Dim strTextNew As String
    Dim lngCount As Long
    Dim strInfo As String
    Dim strMsg As String
    Dim lngTotal As Long
    Dim strCharacters As String
    Dim strChar As String
    
    'To make it easy for you to edit the list of characters to count,
    'the list is defined as a string, strCharacters.
    'Edit the string as desired - for example, add ÆØÅ in case of Danish.
    '=========================
    'The macro does not distinguish between uppercase and lowercase.
    '=========================
    
    strCharacters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
    strMsg = ""
    strText = UCase(ActiveDocument.Range.Text)
    lngTotal = Len(strText)
    
    For lngCount = 1 To Len(strCharacters)
        'Get character lngCount from strCharacters
        strChar = Mid(strCharacters, lngCount, 1)
        
        'To get number of occurrences:
        'Replace strChar with "" and calculate difference in length
        strTextNew = Replace(UCase(strText), strChar, "")
        strInfo = strChar & ":" & vbTab & lngTotal - Len(strTextNew) & vbCr
        'Append info to message
        strMsg = strMsg & strInfo
    Next lngCount
    
    'Show information in dialog box
    strMsg = strMsg & vbCr & vbCr & _
        "Total number of characters in main text story: " & lngTotal
    'If your list strCharacters is not ordered alphabetially,
    'you should edit the MsgBox title below
    MsgBox strMsg, vbOKOnly, "Character Count Sorted Alphabetically"

End Sub

Sub FindNumberOfEachCharacterInActiveDocument_SortedByOccurrences()

'=========================
'Macro created 2022 by Lene Fredborg, DocTools - www.thedoctools.com
'THIS MACRO IS COPYRIGHT. YOU ARE WELCOME TO USE THE MACRO BUT YOU MUST KEEP THE LINE ABOVE.
'YOU ARE NOT ALLOWED TO PUBLISH THE MACRO AS YOUR OWN, IN WHOLE OR IN PART.
'=========================
'The macro creates a list of the number of occurrences in the active document
'of each character in the list you specify.
'The macro checks the main text story only.
'The result is shown in a dialog box, sorted by occurrences of each character in descending order.
'=========================

    Dim strText As String
    Dim strTextNew As String
    Dim lngCount As Long
    Dim strInfo As String
    Dim strMsg As String
    Dim lngTotal As Long
    Dim lngChar As Long
    Dim strCharacters As String
    Dim strChar As String
    Dim oDocTemp As Document
    Dim oTable As Table
    
    Application.ScreenUpdating = False
    
    'To make it easy for you to edit the list of characters to count,
    'the list is defined as a string, strCharacters.
    'Edit the string as desired - for example, add ÆØÅ in case of Danish.
    '=========================
    'The macro does not distinguish between uppercase and lowercase.
    '=========================
    
    strCharacters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
    strMsg = ""
    strText = UCase(ActiveDocument.Range.Text)
    lngTotal = Len(strText)
       
    'Create a temporary document to use to store character count and perform sorting
    'Prevent AutoNew macro from running, if found
    WordBasic.DisableAutoMacros 1
    Set oDocTemp = Documents.Add
    
    'Insert a table to use for adding information for the final message
    With oDocTemp
        .Range.Text = ""
        'Insert 2-column table, number of rows = length of strCharacters
        Set oTable = .Tables.Add(.Range, Len(strCharacters), 2)
    End With
    
    'Add information about each character in strCharacters
    For lngCount = 1 To Len(strCharacters)
        'Get character lngCount from strCharacters
        strChar = Mid(strCharacters, lngCount, 1)
        
        'To get number of occurrences:
        'Replace strChar with "" and calculate difference in length
        strTextNew = Replace(UCase(strText), strChar, "")
        lngChar = lngTotal - Len(strTextNew)
        'Insert result in cell 2 in table
        oTable.Cell(lngCount, 2).Range.Text = lngChar
        'Insert character in cell 1 in table
        oTable.Cell(lngCount, 1).Range.Text = strChar
    Next lngCount
    
    'Sort table by column 2 and convert to text
    oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 2", _
        SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderDescending
    
    oTable.Rows.ConvertToText Separator:=wdSeparateByTabs

    'Store the text from oDocTemp, ready for use in final message
    strInfo = oDocTemp.Range.Text
    
    'Close oDocTemp without saving
    oDocTemp.Close wdDoNotSaveChanges
    
    Application.ScreenUpdating = True
    
    'Show information in dialog box
    strMsg = strInfo & vbCr & vbCr & _
        "Total number of characters in main text story: " & lngTotal
    MsgBox strMsg, vbOKOnly, "Character Count Sorted Descending by Number"
    
    'Clean up
    Set oDocTemp = Nothing
    Set oTable = Nothing
    
    'Enable auto macros again
    WordBasic.DisableAutoMacros 0

End Sub