It is not impossible -
Code:
Sub Macro1()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Underline = True
Do While .Execute
If Not oRng.Font.UnderlineColor = wdColorAutomatic Then
oRng.Font.Underline = wdUnderlineNone
End If
oRng.Collapse 0
Loop
End With
lbl_Exit:
Exit Sub
End Sub