Microsoft Office Forums - View Single Post - [Solved] Find/remove underline with specific color

gmaxey · 07-27-2020, 07:41 AM

To catch headers, footers and other areas of a document you will need to loop through the storyranges. It is more complicated than the code below but this might work:

Code:

Sub Macro1()
Dim oRng As Range
  For Each oRng In ActiveDocument.StoryRanges
  With oRng.Find
    .Font.Underline = wdUnderlineSingle
    Do While .Execute
      If Not oRng.Font.UnderlineColor = wdColorAutomatic Then
        oRng.Font.Underline = wdUnderlineNone
       End If
       oRng.Collapse 0
    Loop
  End With
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Font.Underline = wdUnderlineWords
    Do While .Execute
      If Not oRng.Font.UnderlineColor = wdColorAutomatic Then
        oRng.Font.Underline = wdUnderlineNone
       End If
       oRng.Collapse 0
    Loop
  End With
  Next oRng
lbl_Exit:
  Exit Sub
End Sub