insert sign and bold after found searched phrase

[dagerr]

Hi,
How to modify this code to insert and bold foundend phrase from array, in below code it changes only first word: AAA inestead of whole phrase AAA BBB
Many Thanks




Sub insert_bold_after_second_word()



'Application.ScreenUpdating = False
Dim x As Long, i As Long, ArrFnd()
ArrFnd = Array("AAA BBB", "CCC DDD EEE")
For x = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ArrFnd(x)
.Highlight = False
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
i = i + 1
.Start = .Words.First.Start
.End = .Words.First.End
.MoveEndWhile " ", -1
.InsertAfter ChrW(9658)
.End = .End + 1
.Font.Color = 204
.Font.bold = True
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
End Sub

[gmayor]

To simply make the found words Bold


Sub insert_bold_after_second_word()
'Application.ScreenUpdating = False
Dim x As Long, i As Long, ArrFnd()
ArrFnd = Array("AAA BBB", "CCC DDD EEE")
For x = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ArrFnd(x)
.Highlight = False
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
'i = i + 1
'.Start = .Words.First.Start
'.End = .Words.First.End
'.MoveEndWhile " ", -1
'.InsertAfter ChrW(9658)
'.End = .End + 1
'.Font.Color = 204
.Font.Bold = True
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
End Sub

[dagerr]

ok, but this part of code that You reject is important for me, I want also insert sign and change font color:


Sub insert_bold_after_second_word()
'Application.ScreenUpdating = False
Dim x As Long, i As Long, ArrFnd()
ArrFnd = Array("AAA BBB", "CCC DDD EEE")
For x = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ArrFnd(x)
.Highlight = False
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
'i = i + 1
'.Start = .Words.First.Start
'.End = .Words.First.End
'.MoveEndWhile " ", -1
.InsertAfter ChrW(9658) 'important
'.End = .End + 1
.Font.Color = 204 'important
.Font.Bold = True 'important
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
End Sub

[dagerr]

ok, I just removed aposthropes in lines where code should work and it is seems to work properly.