Sub Delete_Underlines()
' 'Graham Mayor - http://www.gmayor.com - Last updated - 06 Oct 2018
'
' Delete_Underlines Macro
' Will delete all underlines in Document except in Mail addresses (& hyperlinks ??)
Const strUline As String = "1|2|3|4|6|9|10|11|20|23|25|26|27|39|43|55"
Dim vUline As Variant
Dim oRng As Range
Dim oWord As Range
Dim i As Long
    vUline = Split(strUline, "|")
    For i = 0 To UBound(vUline)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Font.Underline = CLng(vUline(i))
            .Replacement.ClearFormatting
            Do While .Execute()
                If oRng.Hyperlinks.Count = 0 Then
                    oRng.Select
                    If MsgBox("Do you want to remove underline from this instance", vbYesNo) = vbYes Then
                        oRng.Font.Underline = wdUnderlineNone
                    End If
                    oRng.Collapse 0
                End If
            Loop
        End With
    Next i
lbl_Exit:
    Set oRng = Nothing
    Set oWord = Nothing
    Exit Sub
End Sub