MS Word VBA - Finding a word and changing its style -

i'm trying find instances of key words in ms word document , change style. key words stored within array , want change style of particular word only. ideally happen type not crucial.

attempt 1 - based on recording macro , changing search term

sub woohoo() dim mykeywords mykeywords= array("word1","word2","word3")  myword= lbound(mykeywords) ubound(mykeywords)      selection.find.clearformatting     selection.find.replacement.clearformatting     selection.find.replacement.style = activedocument.styles("newstyle")     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     selection.find.execute replace:=wdreplaceall next  end sub 

this changes style of entire paragraph words in.

attempt 2 - based on question here how can replace microsoft word character style within range/selection in vba?:

sub fnr2() dim rng range dim mykeywords mykeywords = array("word1","word2","word3")  nkey = lbound(mykeywords) ubound(mykeywords) each rng in activedocument.words     if isinarray(rng, mykeywords(nkey))         rng.style = activedocument.styles("newstyle")     end if next next  end sub 

this finds words in single lines skips words within paragraph reason, e.g. finds

some text word1 more text 

but not

some text before word1 means code above doesn't change format word1 isn't changed in instance 

attempt 3 - autocorrect; not tried:

as alternative thinking use autocorrect. have more 100 keywords , have no idea how add autocorrect list automatically (i'm vba illiterate). other problem see approach believe autocorrect global, whereas need work specific document.

i believe reason why macro isn't finding words due presence of leading or trailing blank spaces. providing have defined style "newstyle" changing if statement in subfnr2

if isinarray(rng, mykeywords(nkey)) 

to

if mykeywords(nkey) = lcase(trim(rng.text)) 

should solve issue. way if want keep style of word depending on whether upper or lower case remove lcase part.

edit:

i have included sub modification below. have tested on examples gave (cut , pasted word) , changed style both instances word1.

sub fnr3() dim rng range dim mykeywords mykeywords = array("word1", "word2", "word3") dim nkey integer  nkey = lbound(mykeywords) ubound(mykeywords) each rng in activedocument.words      if mykeywords(nkey) = lcase(trim(rng.text))         rng.style = activedocument.styles("newstyle")     end if  next rng next nkey  end sub 

ok, document behaves has described, i'm not quite sure why. checked selecting range , word selected, whole paragraph formatted. have modified code modify selection, shown below. did change word.

sub fnr4() dim rng range dim mykeywords mykeywords = array("word1", "word2", "word3") dim nkey integer  nkey = lbound(mykeywords) ubound(mykeywords)     each rng in activedocument.words         selection.collapse         rng.select             if mykeywords(nkey) = lcase(trim(rng.text))                 selection.style = activedocument.styles("newstyle")             end if      next rng next nkey  end sub