Hi all, I have a word document that contains multiple tables, within the tables, there is a tolerance column that contains a text value - "Green, Amber or Red".

I am using the below code to find the above-mentioned text and change the cell backgrounds colour to match the text .e. Green text = Green background and so on.

I would appreciate some assistance with two issues:
1. merge the three codes into one, and


2. tweak the Amber code as there is no value for "wdOrange" for Amber text. This procedure clearly doesn't run as-is.


[Sub GreenText()

Dim r As Range
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="Green", MatchWholeWord:=True, Forward:=True) = True
r.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
Loop

End With

End Sub]


[Sub AmberText()

Dim r As Range
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="Amber", MatchWholeWord:=True, Forward:=True) = True
r.Cells(1).Shading.BackgroundPatternColorIndex = wdOrange
Loop

End With

End Sub]

[Sub RedText()

Dim r As Range
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="Red", MatchWholeWord:=True, Forward:=True) = True
r.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
Loop

End With

End Sub]



Appreciate any assistance

So for the sub AmeberText() wd=Orange i have tweaked my original code to:

[Sub AmberText()
Const wdOrange As Long = 41215
Dim r As Range

Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="Amber", MatchWholeWord:=True, Forward:=True) = True
r.Cells(1).Shading.BackgroundPatternColor = wdOrange
.Font.Color = wdOrange
Loop

End With

End Sub]

It will only colour the 1st "Amber" cell background to orange then it stops, any ideas on how to tweak it to change all the text Ambers the entire document?

Solved it - Just removed the one from the r.cells(1).shading.BackgroundPatternColor = wdOrange row.

[Sub AmberText()

Dim r As Range, wdOrange As Long
wdOrange = 41215
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="Amber", MatchWholeWord:=True, Forward:=True) = True
r.Cells.Shading.BackgroundPatternColor = wdOrange
Loop
End With

End Sub]