Microsoft Office Forums - View Single Post - [Solved] Macro to find and replace headings in bold and underline

gmaxey · 02-13-2016, 09:10 AM

You didn't answer the question asked. If a particular style is applied to all of the headings (and not other text) then it is simply a matter of modifying the style to include bold and underline font attributes.

Regardless, here is a macro that might meet your needs:

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim arrFind() As String
Dim lngIndex As Long
Dim oRng As Range
  arrFind = Split("HISTORY OF PRESENT ILLNESS:,PHYSICAL EXAM:,RADIOGRAPHS:,SOCIAL HISTORY:,FAMILY HISTORY:,REVIEW OF SYSTEM:," _
                & "BRIEF HISTORY:,CLINICAL EXAM:,ASSESSMENT AND PLAN:,IMPRESSION AND PLAN:", ",")
  For lngIndex = 0 To UBound(arrFind)
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = arrFind(lngIndex)
      With .Replacement
        .Text = arrFind(lngIndex)
        .Font.Bold = True
        .Font.Underline = True
      End With
      .Execute Replace:=wdReplaceAll
    End With
  Next
lbl_Exit:
  Exit Sub
End Sub