VBA Macro To Format All Headings in Document As Bold

Question

I'm trying to automate a search/replace of headings in a Word 2013 document (note, these are not Word style headings but simply text typed in uppercase with a colon). For example:

CHIEF COMPLAINT:

PHYSICAL EXAMINATION:

The search and replace is only to format the headings to bold, which otherwise has to be done manually, otherwise the heading text remains the same. There is no way to know which headings will be in the document (or if any at all), which order or whether the first line of the document will include a heading or not.

A manual search/replace for: ^13(*:)

To this: ^p\\1

Works, except if the first instance is at the beginning of the file (no return).

The macro I've been using is this:

Sub BoldHeadings()
'
' BoldHeadings Macro
'
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Text = "^13(*:)"
  .Replacement.Text = "^p\1"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
End With
Application.ScreenUpdating = True
End Sub

As stated, this works fine except if the first instance is at the beginning of the file. Is there another way I can achieve this?

Thanks!

Answer 1

Try:

Sub BoldHeadings()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertBefore vbCr
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Font.Bold = True
    .Text = "^13*:"
    .Replacement.Text = "^&"
    .Format = True
    .Forward = True
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
  .Paragraphs.First.Range.Delete
End With
Application.ScreenUpdating = True
End Sub