Microsoft Office Forums - View Single Post

macropod · 12-06-2019, 08:07 PM

That's because the code was written to not delete anything from the first subordinate heading onwards. If you delete everything after every Heading 1, you're liable to end up with an essentially empty document. Still, if that's what you want:

Code:

Sub DeleteHeadingText()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Style = wdStyleHeading1
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    Rng.Text = vbNullString
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

For use with other heading levels, simply change the '1' in 'wdStyleHeading1'.