VBA Word - Create custom headings, apply them and create Table of contents using the styles

The following code creates custom headings, apply them and create Table of contents using the styles in Word document:

Sub CreateCustomHeadings()
    Dim CustomHd1 As Style
    Dim CustomHd2 As Style
    
    ' Create CustomHd1 style
    Set CustomHd1 = ActiveDocument.Styles.Add(Name:="CustomHd1", Type:=wdStyleTypeParagraph)
    With CustomHd1.Font
        .Name = "Arial"
        .Size = 13.5
        .Bold = True
    End With
    
    ' Create CustomHd2 style
    Set CustomHd2 = ActiveDocument.Styles.Add(Name:="CustomHd2", Type:=wdStyleTypeParagraph)
    With CustomHd2.Font
        .Name = "Arial"
        .Size = 10
        .Bold = True
    End With
End Sub
Sub ApplyCustomHeadings()
    Dim para As Paragraph
    
    ' Loop through all paragraphs in the document
    For Each para In ActiveDocument.Paragraphs
        With para.Range
            ' Apply CustomHd1 if the font matches
            If .Font.Name = "Arial" And .Font.Size = 13.5 And .Font.Bold = True Then
                .Style = ActiveDocument.Styles("CustomHd1")
            ' Apply CustomHd2 if the font matches
            ElseIf .Font.Name = "Arial" And .Font.Size = 10 And .Font.Bold = True Then
                .Style = ActiveDocument.Styles("CustomHd2")
            End If
        End With
    Next para
End Sub
Sub CreateTOCWithCustomHeadings()
    Dim tocRange As Range
    Dim toc As TableOfContents
    
    ' Insert a paragraph at the beginning of the document for the TOC
    Set tocRange = ActiveDocument.Range(0, 0)
    tocRange.InsertParagraphBefore
    tocRange.InsertBefore "Table of Contents"
    tocRange.InsertParagraphAfter
    tocRange.InsertParagraphAfter
    
    ' Add the TOC using the custom heading styles
    Set toc = ActiveDocument.TablesOfContents.Add( _
        Range:=tocRange.Paragraphs(2).Range, _
        UseHeadingStyles:=False, _
        IncludePageNumbers:=True, _
        RightAlignPageNumbers:=True, _
        UseHyperlinks:=True _
    )
    
    ' Add the custom styles to the TOC
    toc.AddText Style:="CustomHd1", Level:=1
    toc.AddText Style:="CustomHd2", Level:=2
    
    ' Update the TOC to include all headings
    toc.Update
End Sub