Tagging Highlighted text with appropriate color

JamesKenwood · #1 11-23-2022, 04:50 PM

I am pretty new to VBA so am trying to find my feet to do a task but can't find a sample anywhere to achieve this.

I need to find all highlighted text in a given colour (lets say yellow for now but will want to do blue too) then tag that text with "[color:yellow]" and [/color]. So I can maintain that information on export to another format.

So far I have the following, but it has problems.
1. I need to run it multiple times to find each highlight, I just want it to process whole document
2. It doesn't find the yellow highlight on lines that have blue and yellow highlights (so highlighting individual words not a whole paragraph)
3. The end tag goes onto the following line

Any guidance would be so much appreciated...

Code:

Sub Highlighting()
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindContinue
        .Highlight = True
        Do
        .Execute
          Loop Until Selection.Range.HighlightColorIndex = wdYellow _
          Or Not .Found
            Selection.Range.InsertBefore "[Color: Yellow ]"
            Selection.Range.InsertAfter "[/Color]"
    End With
End Sub

Guessed · #2 11-23-2022, 11:32 PM

Does this work for you?

Code:

Sub HighlightTagger()
  Dim aRng As Range
  Set aRng = ActiveDocument.Range
  With aRng.Find
    .Text = ""
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = False
    .Forward = True
    .Wrap = wdFindStop
    .Highlight = True
    Do While .Execute
      Select Case aRng.HighlightColorIndex
        Case wdYellow
          aRng.InsertBefore "[Color: Yellow]"
        Case wdBlue
          aRng.InsertBefore "[Color: Blue]"
        Case Else
          aRng.InsertBefore "[Color: Other]"
      End Select
      If aRng.Characters.Last = vbCr Then
        aRng.Characters.Last.InsertBefore "[/Color]"
      Else
        aRng.InsertAfter "[/Color]"
      End If
      aRng.Collapse Direction:=wdCollapseEnd
    Loop
  End With
End Sub

JamesKenwood · #3 11-24-2022, 03:50 AM

Thank you so much for your help Andrew. this is almost perfect. The issue is that when a paragraph contains two highlight colours it doesn't pick it up.

If you look at this image you will see what I mean..

If you can figure out a way to solve that I would be so grateful!

Guessed · #4 11-24-2022, 02:52 PM

That 'blue' you are showing is referred to as Turquoise by Microsoft (or cyan by me) so you would need to change the blue case in the code to

Code:

Case wdTurquoise
          aRng.InsertBefore "[Color: Blue]".

The point of the Case Else is so that when highlight colours were not explicitly named above you had a way of catching those instances. When there are contiguous blocks of different highlight colours they will be handled by the Case Else statement. You would need to add code in that case to step through each character in the found range and test the highlights. I haven't got time for that right now but if no one gets back to you I can have a look at it in a few days.

JamesKenwood · #5 11-28-2022, 07:25 AM

Thanks for your help Andrew, very much appreciated!!

I had added the extra case for Turquoise, your code was great at showing that was needed. I think I have what I need for now, so please don't spend more of your time going to character level.

Thanks again!!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Text Field [content control] - Default text color vs Filled Text color	jackcoletti	Word	3	02-01-2017 08:10 AM
Cannot see highlighted text for moving text in a do ument	Jonfrank1@me.com	Project	1	01-09-2017 06:04 PM
I need to convert shaded text into highlighted text on about 80 different long documents. VBA macro?	AustinBrister	Word VBA	8	05-28-2015 02:42 PM
Formatting- Apply changes to highlighted text results in same change to other text	sential	Word	6	01-10-2014 03:22 PM
Macro for tagging and rearranging selected text for revision	caotico	Word VBA	0	03-28-2012 06:35 PM