MS Word VBA - search for a word and change its style

Question

I try to find all instances of keywords in an MS Word document and change their style. The keywords are stored in an array, and I want to change the style of only a specific word. Ideally, this will happen when I print, but that doesn't matter.

Attempt 1 - Based on macro recording and search query modification

Sub Woohoo() Dim mykeywords mykeywords= Array("word1","word2","word3") For myword= LBound(mykeywords) To UBound(mykeywords) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Style = ActiveDocument.Styles("NewStyle") With Selection.Find .Text = mykeywords(myword) .Replacement.Text = mykeywords(myword) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next End Sub 

This changes the style of the entire paragraph in which the words are located.

Attempt 2 - Based on this question here How to replace Microsoft Word character style in range / selection in VBA? :

 Sub FnR2() Dim rng As Range Dim mykeywords mykeywords = Array("word1","word2","word3") For nKey = LBound(mykeywords) To UBound(mykeywords) For Each rng In ActiveDocument.Words If IsInArray(rng, mykeywords(nKey)) Then rng.Style = ActiveDocument.Styles("NewStyle") End If Next Next End Sub 

This finds words that are on the same line, but skips words that are in the paragraph for some reason, for example. He finds

 Some text word1 more text 

but not

 Some text before word1 means that the code above doesn't change the format Word1 also isn't changed in this instance 

Attempt 3 - AutoCorrect; didn't really try:

As an alternative, I thought to use AutoCorrect. However, I have more than 100 keywords, and I have no idea how to add this to the AutoCorrect list automatically (I'm pretty illiterate VBA). Another problem that I would like to see with this approach is that I believe that AutoCorrect is global, while I only need it to work with a specific document.

Answer 1

I believe the reason your macro cannot find a word is due to leading or trailing spaces. If you have already defined the "NewStyle" style by changing the if statement in SubFnR2 from

 If IsInArray(rng, mykeywords(nKey)) Then 

to

 If mykeywords(nkey) = LCase(Trim(rng.Text)) Then 

Should solve the problem. By the way, if you want to preserve the style of a word depending on whether it is upper or lower case, then delete the LCase part.

Edit:

I have included sub with the modification below. I tested it with the examples you gave (cut and pasted into a word), and it changed the style for both instances of word1.

 Sub FnR3() Dim rng As Range Dim mykeywords mykeywords = Array("word1", "word2", "word3") Dim nkey As Integer For nkey = LBound(mykeywords) To UBound(mykeywords) For Each rng In ActiveDocument.Words If mykeywords(nkey) = LCase(Trim(rng.Text)) Then rng.Style = ActiveDocument.Styles("NewStyle") End If Next rng Next nkey End Sub 

Well, your document behaves the way you described, I don’t quite understand why. I checked the range selection and only the word was selected, but then the entire paragraph was formatted. I changed the code to change the selection as shown below. It just changed the word.

 Sub FnR4() Dim rng As Range Dim mykeywords mykeywords = Array("word1", "word2", "word3") Dim nkey As Integer For nkey = LBound(mykeywords) To UBound(mykeywords) For Each rng In ActiveDocument.Words Selection.Collapse rng.Select If mykeywords(nkey) = LCase(Trim(rng.Text)) Then Selection.Style = ActiveDocument.Styles("NewStyle") End If Next rng Next nkey End Sub