TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub ReUnderline()

    Dim x As Long

    With ActiveWindow.Selection.TextRange
        ' turn off underlining overall
        .Font.Underline = msoFalse
        For x = 1 To .Words.Count
            If Right$(.Words(x), 1) = " " Then
                .Words(x).Characters(1, .Words(x).Characters.Count - 1).Font.Underline = msoTrue
            Else
                .Words(x).Font.Underline = msoTrue
            End If
        Next
    End With

End Sub

If you haven't underlined anything yet and just want to underline the words (but not punctuation characters), try this:

Sub UnderlineUs()
    Dim oRng As TextRange
    Dim x As Long

    Set oRng = ActiveWindow.Selection.TextRange
    For x = 1 To oRng.Characters.Count
        Select Case oRng.Characters(x)
            Case Is = " ", ",", ".", "?", "!", vbTab
                ' Don't underline it
                ' Add more characters above as needed
            Case Else
                oRng.Characters(x).Font.Underline = True
        End Select
    Next
End Sub