Text Replacement

I just wondering if there is a way to modify this code ( Found on Oberon Place by Shelbym) to replace multitude of text 

thanks

Sub ReplaceTextAcrossOpenDocs()

Const txtFIND As String = "Yellow" 'The word you want to find and replace
Const txtREPLACE As String = "Blue" 'The new word to replace the old


Dim d As Document
Dim p As Page

For Each d In Documents 'Loop all the open documents
For Each p In d.Pages 'Loop each page
p.TextReplace txtFIND, txtREPLACE, True, False
Next p
Next d

End Sub