Remove the underline attribute from characters with descenders

Article contributed by Bill Coan

Select the text that you want to fix, then run the following macro

Sub FixUnderlinedText()

For Each oCharacter In Selection.Characters
    If oCharacter Like "[qypjg]" Then
        oCharacter.Font.Underline = wdUnderlineNone
    End If
Next oCharacter

End Sub