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

VBA Word - Delete all hyperlinks from document

The following VBA code deletes all hyperlinks from document:

Sub DeleteHyperlinks()
    Dim doc As Document
    Dim hyp As Hyperlink
    Dim i As Integer
    Dim max As Integer
    
    max = ActiveDocument.Hyperlinks.Count
    On Error Resume Next
    For i = 1 To max
        ActiveDocument.Hyperlinks(i).Delete
    Next
End Sub

The following VBA code deletes all hyperlinks from document:

Sub DeleteHyperlinks()
Sub DeleteHyperLinks()
    Dim h As Hyperlink
    For Each h In ActiveDocument.Hyperlinks
        h.Delete
    Next
End Sub

The following VBA code deletes all hyperlinks from document:

Sub DeleteHyperlinks()
    Dim doc As Document
    Dim hyp As Hyperlink
    Dim i As Integer
    Dim max As Integer
    
    max = ActiveDocument.Hyperlinks.Count
    On Error Resume Next
    For i = 1 To max
        ActiveDocument.Hyperlinks(i).Delete
    Next
End Sub

The following VBA code deletes all hyperlinks from document:

Sub DeleteHyperlinkText()
    Dim h As Hyperlink
    Dim rng As Range
    ' Loop backwards to avoid collection shifting
    Dim i As Long
    For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
        Set h = ActiveDocument.Hyperlinks(i)
        Set rng = h.Range
        rng.Delete
    Next i
End Sub

The following VBA code deletes all hyperlinks with its text from document:

Sub DeleteLinesWithHyperlinkContainingQuestion()
    Dim para As Paragraph
    Dim hLink As Hyperlink
    
    ' Loop through paragraphs backward to avoid index issues while deleting
    Dim i As Long
    For i = ActiveDocument.Paragraphs.Count To 1 Step -1
        Set para = ActiveDocument.Paragraphs(i)
        
        ' Check if any hyperlink in this paragraph contains "Question"
        For Each hLink In para.Range.Hyperlinks
            If InStr(1, hLink.TextToDisplay, "Question", vbTextCompare) > 0 Then
                para.Range.Delete
                Exit For ' Exit inner loop after deletion to avoid error
            End If
        Next hLink
    Next i
End Sub

The following VBA code deletes all hyperlinks with its text from document:

Sub DeleteParagraphsWithHyperlinkedQuestionUsingFind()
    Dim rng As Range
    Set rng = ActiveDocument.Content
    
    With rng.Find
        .ClearFormatting
        .Text = "Question[0-9]{1,}"
        .MatchWildcards = True
        .Forward = True
        .Wrap = wdFindStop
        
        Do While .Execute
            ' Check if found text is part of a hyperlink
            If rng.Hyperlinks.Count > 0 Then
                rng.Paragraphs(1).Range.Delete
            Else
                rng.Collapse Direction:=wdCollapseEnd
            End If
        Loop
    End With
End Sub