Solved: Remove text highlights

[Dave T]

Hello All,

Rather than use 'track changes' to identify new/added text I manually use the following macro on the highlighted text:


Sub HighlightTextAdditions()
' Colours selected text violet with violet underline and light yellow shading
Dim rng As Range
Set rng = Selection.Range
' Only if text is selected
If Len(rng.Text) > 0 Then
rng.Font.ColorIndex = wdViolet
rng.Font.Underline = wdUnderlineSingle
rng.Shading.BackgroundPatternColor = wdColorLightYellow
End If
End Sub

I also use a version of the above to highlight text that is to be deleted.
Greg Maxey helped me out with a macro that steps through the text and deletes any text with strikethrough.
http://www.vbaexpress.com/forum/showthread.php?t=39296

When the text additions have been approved I need a macro that will remove the background pattern shading, return the text to its default colour and remove the underline.

I have some code which does this however there is a problem when hyperlinks are encountered within the text additions.

The macros I have tried using remove the underline from the hyperlink as well (something I do not want it to do)


Sub RemoveTextAdditionsColour()
' Removes formatting applied by 'ColourTextAdditions' macro
Dim rng As Range
Set rng = Selection.Range
' Only if text is selected
If Len(rng.Text) > 0 Then
rng.Font.ColorIndex = wdAuto
rng.Font.Underline = wdUnderlineNone
rng.Font.Shading.Texture = wdTextureNone
rng.Font.Shading.ForegroundPatternColor = wdColorAutomatic
rng.Font.Shading.BackgroundPatternColor = wdColorAutomatic
End If

Call ApplyHyperlinkStyle

End Sub

Once again I have tried to use another example of code from Greg Maxey, and whilst this works it removes the hyperlink from the first and last letters of the hyper-linked text


Sub ApplyHyperlinkStyle()
Dim oLink As Hyperlink
For Each oLink In ActiveDocument.Hyperlinks
oLink.Range.Style = "Hyperlink"
Next oLink
End Sub

Does anyone have any solution for removing the formatting of my text additions macro, but only remove the background shading and retain the blue hyperlink font colour with its underline.

Any help would be appreciated.

Regards,
Dave T

[macropod]

Hi Dave,

I'd be inclined to re-code the highlighting macro as:
Sub HighlightTextAdditions()
' Colours selected text violet with violet underline and light yellow shading
With Selection
' Only if text is selected
If Len(.Text) > 0 Then
With .Font
.ColorIndex = wdViolet
.Underline = wdUnderlineSingle
.Shading.BackgroundPatternColor = wdColorLightYellow
End With
End If
End With
End Sub
Note that this applies the shading to the font.

Then, to clear the shading and restore hyperlink formatting, you could use:
Sub HighlightTextCleanUp()
Application.ScreenUpdating = False
Dim HLnk As Hyperlink
With ActiveDocument.Content
With .Find
.ClearFormatting
.Text = ""
With .Font
.Shading.BackgroundPatternColor = wdColorLightYellow
.Underline = wdUnderlineSingle
.ColorIndex = wdViolet
End With
With .Replacement
.ClearFormatting
.Text = ""
End With
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
With .Font
.Shading.BackgroundPatternColorIndex = wdAuto
.Underline = wdUnderlineNone
.Color = wdColorAutomatic
End With
For Each HLnk In .Duplicate.Hyperlinks
HLnk.Range.Style = "Hyperlink"
Next
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub

[Dave T]

Hello Paul,

Thank you very much for your reply.
It works perfectly.

I did realise as soon as I posted the message that the hyperlinks were associated with a style, and to change them back to hyperlinks was to reapply the style again.

Thanks for comfirming this for me and all you help.

Regards,
Dave T

[Dave T]

Hello All,

I have a problem with the 'HighlightTextCleanUp' macro from macropod.

The problem comes when there is text additions highlighted within tables.
If the highlighted text is within a table, the code enters an endlesss loop and I have problems stopping the endless loop.

So I have two questions:

What needs to be added to the code to allow it to work within tables as well as text outside of tables ???
If a macro gets into one of these endless loop, what is the best way to stop it ???Regards,
Dave T

[macropod]

Hi Dave,

You can fix that by inserting:
If .Information(wdWithInTable) = True Then .End = .End + 1
after:
Do While .Find.Found

[Dave T]

Hello macropod,

Once again you come to the party.
Much appreciated.

Regards,
Dave T