Find/remove underline with specific color

eduzs · #1 07-26-2020, 06:12 AM

Hi,
Is there a way to find and remove underlines which underline color is <> of wdColorAutomatic?

I was thinking about find/replace routine, but it not accepts "<>" signal in search criteria
Thanks

gmaxey · #2 07-26-2020, 07:08 AM

1. Find/remove underline with specific color?

2. Is there a way .... which underline color is <> wdColorAutomatic

Those are two separate questions.

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Font.UnderlineColor = wdColorRed
    While .Execute
      oRng.Font.Underline = wdUnderlineNone
    Wend
  End With
lbl_Exit:
  Exit Sub
End Sub

Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Font.Underline = True
    While .Execute
      If oRng.Font.UnderlineColor <> wdColorAutomatic Then
        oRng.Font.Underline = wdUnderlineNone
      End If
    Wend
  End With
lbl_Exit:
  Exit Sub
End Sub

eduzs · #3 07-26-2020, 07:42 AM

Thanks gmaxey,

I think that the code needed is the second, but it only remove underline from the 1st occurrence of a underline <> wdcolorautomatic.

eduzs · #4 07-26-2020, 08:16 AM

This adaptation based on your code works but results in infinite loop

The Exit Do is not working.
Update: the code below does not work if the document have headers.
The document can have words underlined in up to 3 colors or none underlined, one of which is automatic. I need to remove only underlines that are not wdColorAutomatic.

Code:

Set oRng = ActiveDocument.range
With oRng.Find
    .Font.Underline = True
    .Forward = True
    .Wrap = wdFindContinue
    .Execute
Do While .Found
    If oRng.Font.UnderlineColor <> wdColorAutomatic Then
        oRng.Font.Underline = wdUnderlineNone
    End If
    If .Found = ActiveDocument.range.End Then Exit Do
    .Execute
Loop
End With

Update2:
Maybe this is impossible with find/found loop, with for/next loop (each word) I was able to get the task done, but takes a lot of time.
For now I chose to simply remove the entire underline.

Thanks!

gmayor · #5 07-26-2020, 11:03 PM

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

eduzs · #6 07-27-2020, 05:33 AM

Hello, for a reason I don't know, this code is not working.
During execution, does not even enter the while loop.

gmayor · #7 07-27-2020, 06:18 AM

It works fine - post a copy of your document so that we can see why it doesn't work there.

eduzs · #8 07-27-2020, 06:35 AM

Hi!
I identified the problem, at least in my document the ".Font.Underline" property does not works with boolean true/false values, instead, it should need one of wdUnderline enumeration values.
The document have two underline types , value 1 = wdUnderlineSingle and 2 wdUnderlineWords, using two steps (with 1 or 2 instead of true) it works fine.
Now I need a way to translate this to the code above.
Thanks all for helping.

gmaxey · #9 07-27-2020, 07:41 AM

To catch headers, footers and other areas of a document you will need to loop through the storyranges. It is more complicated than the code below but this might work:

Code:

Sub Macro1()
Dim oRng As Range
  For Each oRng In ActiveDocument.StoryRanges
  With oRng.Find
    .Font.Underline = wdUnderlineSingle
    Do While .Execute
      If Not oRng.Font.UnderlineColor = wdColorAutomatic Then
        oRng.Font.Underline = wdUnderlineNone
       End If
       oRng.Collapse 0
    Loop
  End With
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Font.Underline = wdUnderlineWords
    Do While .Execute
      If Not oRng.Font.UnderlineColor = wdColorAutomatic Then
        oRng.Font.Underline = wdUnderlineNone
       End If
       oRng.Collapse 0
    Loop
  End With
  Next oRng
lbl_Exit:
  Exit Sub
End Sub

eduzs · #10 07-27-2020, 07:43 AM

Thanks gmaxey and gmayor! Works as intended.
Now only minor changes are needed, I will mark this topic as solved.
Ps: I changed the codes that underline texts so that they use only one form of underlining, avoiding the need for a loop or two steps editing.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Remove white text background (keeping the font color and page color intact	cc3125	Word	1	10-26-2015 06:44 PM
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM
Find instance of a word in a specific style and change its color	hwg	Word VBA	7	02-20-2014 10:59 PM
remove color from find/replace?	Cobb78	Word	1	05-26-2012 06:16 PM
How to remove the UNDERLINE from a hyperlink text?	Learner7	PowerPoint	3	05-17-2010 09:35 PM