VBA Word: Need to find, select, and tag groups of blue words

[HowdeeDoodee]

I have a library of e-documents I need to convert to another format. In each of the documents I have words in blue font. The groups of blue words can be any length, from 1 word up to 100 words or more. I need a way to loop a vba word macro so the macro selects the groups of blue words and puts a beginning tag and an ending tag around the group of blue words. The ending tag would equal xxx and the beginning tag would equal yyy.

The following code only finds individual characters in individual words which is not what I need.

 Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Font.Color = wdColorBlue
        End With
    Selection.Find.Execute

Thank you in advance for your reply.

 

[SkipVought]

Hi,

How about this?

    With Selection.Find
        .ClearFormatting
        .Font.Color = wdColorBlue
        .Execute
    End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[HowdeeDoodee]

Thank you skip for the code. As I indicated in the first post, I need to find groups of text in blue, not just individual characters or even individual words. The blue characters to be found would be like words that are underlined in the following passage.

Before macro is run
"In every attempt, [colorblue]one must[/colorblue]] take risks. Being [colorblue]able[/colorblue] to take risks must be learned from the [colorblue]experience of not only succeeding[/colorblue] but also of [/colorblue]failing[colorblue]. To learn to fail and come back again is an [colorblue]incredible[/colorblue] life lesson."

After macro is run
"In every attempt, xxx[colorblue]one must[/colorblue]yyy take risks. Being xxx[colorblue]able[/colorblue]yyy to take risks must be learned from the xxx[colorblue]yyyexperience of not only succeeding[/colorblue]yyy but also of xxx[colorblue]failing[/colorblue]yyy. To learn to fail and come back again is an xxx[colorblue]incredible[/colorblue]yyy life lesson.

 

[HowdeeDoodee]

Well, shoot. I was trying to color the words blue in the above post and then show how the xxx and zzz tags are to be inserted before and after the blue words when the macro is run. I am sure Tek Tips has a way of letting the users edit but I cannot find it.

 

[SkipVought]

just [blue]BLUE[/blue] in BRACKETS. Forget the word, COLOR.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[HowdeeDoodee]

OK, let's try this again.

Before macro is run
"In every attempt, [blue]one must[/blue]] take risks. Being [blue]able[/blue] to take risks must be learned from the [blue]experience of not only succeeding[/blue] but also of [blue]failing[/blue]. To learn to fail and come back again is an [blue]incredible[/blue] life lesson."

After macro is run
"In every attempt, xxx[blue]one must[/blue]yyy take risks. Being xxx[blue]able[/blue]yyy to take risks must be learned from the xxx[blue]yyyexperience of not only succeeding[/blue]yyy but also of xxx[blue]failing[/blue]yyy. To learn to fail and come back again is an xxx[blue]incredible[/blue]yyy life lesson.

 

[HowdeeDoodee]

I developed a solution for this issue and here it is.

A macro to put xxx at the right of the word.

Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Font.Color = wdColorBlue
        End With
    Selection.Find.Execute
' finds just a space after the blue Hebrew word
    With Selection.Find
        .Text = " "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
'then types in three zzz's and a space
Selection.TypeText Text:="zzz "

A macro to put xxx to the left of the word

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "zzz"
        .Replacement.Text = "zzz"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = " "
        .Replacement.Text = "zzz"
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.TypeText Text:=" xxx"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "zzz"
        .Replacement.Text = "zzz"
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "zzz"
        .Replacement.Text = "zzz"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

Then I do a general replace:
I replace zzz xxx with a space

Then I replace
zzz xxx,zzz xxx with just a comma where a comma was found in the sequence of blue words

Thank you to those of you who contributed to this thread.

 

[HowdeeDoodee]

This issue has been solved. Mods, could you please mark as solved in the thread title? Thank you.

 

[SkipVought]

That's up to Buffalo Bob.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[TonyJollans]

I'm glad you've solved it although I don't understand what you've posted.

Yes, Word's pattern matching is, shall we say, unique, but you find single characters (in your original post) because you ask to find single characters - that's what [blue][?[/blue] means.

If you leave the find text blank and set the find format to blue, Word should find strings of blue text, which you can replace with start_tag^&end_tag - with wildcards false.

There may be odd effects if you are using right-to-left text, I'm not sure.

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[fumei]

And just for future consideration...

If you had a MyBlue character style - and used it - then it would be very easy. Or, at least easy if you do not mind your xxx and yyy also being MyBlue.

Dim r As Range
Set r = ActiveDocument.Range
With r.Find
    .ClearFormatting
    .Style = "MyBlue"
    Do While .Execute(Findtext:="", Forward:=True) = True
       With r
          .InsertBefore Text:="xxx"
          .InsertAfter Text:="yyy"
          .Collapse 0
       End With
    Loop
End With

This searches for strings that have the MyBlue character style (no matter what length - "one must", "experience of not only succeeding"...it does not matter), and puts "xxx" before that string, and "yyy" after that string.

There is no use of Selection, and therefore NO resources going through the screen buffer.

It could be adjusted to make the added text not use the MyBlue style.

faq219-2884

Gerry
My paintings and sculpture