VBA In Word - Replace Text With Formatting

[LM100]

Hi,

I'm trying to find a number of phrases in a document and colour them according to which phrase.

Using macro recorder, I've made the following but I'm wondering if there's a clear way of writing the code so more phrases can be added at a later date.

Sub ColourTextMulti()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = wdColorBlue
With Selection.Find
.Text = "Phrase One"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = wdColorRed
With Selection.Find
.Text = "Phrase Two"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Could this be written in a form that listed

"Phrase One" = wdColorRed
"Phrase Two" = wdColorBlue

....etc?

 

[Macropod]

Hi LM,

It's not exactly clear whether you merely want to simplify the addition of more expressions, each with different colourings, or you want to be able to apply a range of colourings to multiple find strings. For the first, you could do something along the lines of the following:

Sub ColourTextMulti()
With Selection.Find
  .ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  .Replacement.ClearFormatting
  .Replacement.Text = "^&"
  .Text = "Phrase One"
  .Replacement.Font.Color = wdColorBlue
  .Execute Replace:=wdReplaceAll
  .Text = "Phrase Two"
  .Replacement.Font.Color = wdColorRed
  .Execute Replace:=wdReplaceAll
  .Text = "Phrase Three"
  .Replacement.Font.Color = wdColorGreen
  .Execute Replace:=wdReplaceAll
End With
End Sub

For some ideas on how to go about the second, see the code I posted at: http://www.vbaexpress.com/forum/showthread.php?t=33793&page=2