Sub Delete_Underlines()
' 'Graham Mayor - http://www.gmayor.com - Last updated - 03 Oct 2018
'
' Delete_Underlines Macro
' Will delete all underlines in Document except in Mail addresses (& hyperlinks ??)

Dim oRng As Range
Dim oWord As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .ClearFormatting
        .Font.Underline = wdUnderlineSingle
        .Replacement.ClearFormatting
        Do While .Execute()
            If oRng.Hyperlinks.Count = 0 Then
                oRng.Font.Underline = wdUnderlineNone
                oRng.Collapse 0
            End If
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
    Set oWord = Nothing
    Exit Sub
End Sub