Jonathan,

I noticed that a normal find and replace also misses text in a textbox
located in a header.

After looking at your tip to Andy, I attempted the following which
appears to be a more comprehensive "find and replace anywhere" macro.
Would you please look at it an comment on where improvements could be
made:

Public Sub FindReplaceAnywhereWithVBA()
Dim rngstory As Word.Range
Dim findText As String
Dim Replacement As String
Dim pJunk As Long

findText = "test find"
Replacement = "test replaced"
'Fix the skipped blank Header/Footer problem
pJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
 SrchAndReplInStory rngstory, findText, Replacement
 On Error Resume Next
 If rngstory.ShapeRange.Count > 0 Then
   Dim oShp As Shape
   For Each oShp In rngstory.ShapeRange
     If oShp.TextFrame.HasText Then
       SrchAndReplInStory oShp.TextFrame.TextRange, findText,
Replacement
    End If
   Next
 End If
 On Error GoTo 0
Next
End Sub

Public Sub SrchAndReplInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
Do Until (rngstory Is Nothing)
 With rngstory.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = strSearch
   .Replacement.Text = strReplace
   .Replacement.Font.Color = wdColorBlue
   .Execute Replace:=wdReplaceAll
 End With
 Set rngstory = rngstory.NextStoryRange
Loop
End Sub

Jonathan (and all others)

Please disregard the earlier reply.  Seems that version only worked for
the header/footer in first section.

I have moved the addtional code in the actual search routine and it
appears to work now in all headers, including headers that are not
linked to a previous header:

Public Sub FindReplaceWithVBA()

Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceText As String
Dim lngJunk As Long

pFindTxt = InputBox("Enter the text that you want to find then
replace.", "Batch Replace Anywhere")
If pFindTxt = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
Tryagain:
pReplaceText = InputBox("Enter the pReplaceText text.", "Replace
Anywhere ")
If pReplaceText = "" Then
 If MsgBox("Do you just want to delete the found text?",
vbYesNoCancel) = vbNo Then
   GoTo Tryagain
 ElseIf vbCancel Then
   MsgBox "Cancelled by User."
 Exit Sub
 End If
End If
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
 SearchAndReplaceInStory rngStory, pFindTxt, pReplaceText
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
Dim oShp As Shape
ResetFRParameters
'This routine supplied by Peter Hewett
Do Until (rngStory Is Nothing)
 With rngStory.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = strSearch
   .Replacement.Text = strReplace
   .Execute Replace:=wdReplaceAll
 End With
 On Error Resume Next
 If rngStory.ShapeRange.Count > 0 Then
   For Each oShp In rngStory.ShapeRange
     If oShp.TextFrame.HasText Then
       With oShp.TextFrame.TextRange.Find
         .ClearFormatting
         .Replacement.ClearFormatting
         .Text = strSearch
         .Replacement.Text = strReplace
         .Execute Replace:=wdReplaceAll
       End With
     End If
   Next
 End If
 On Error GoTo 0
 Set rngStory = rngStory.NextStoryRange
Loop
End Sub

Jonathan (and others)

Sorry for being troublesome.  I think I have managed to make this a bit
more presentable:

Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape

pFindTxt = InputBox("Enter the text that you want to find.", _
"FIND")
If pFindTxt = "" Then
 MsgBox "Cancelled by User"
 Exit Sub
End If
Tryagain:
pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
If pReplaceTxt = "" Then
 If MsgBox("Do you just want to delete the found text?",
vbYesNoCancel) = vbNo Then
   GoTo Tryagain
 ElseIf vbCancel Then
   MsgBox "Cancelled by User."
   Exit Sub
 End If
End If
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
 'Iterate through all linked stories
 Do
   SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
   On Error Resume Next
   If rngStory.ShapeRange.Count > 0 Then
     For Each oShp In rngStory.ShapeRange
       If oShp.TextFrame.HasText Then
         SearchAndReplaceInStory oShp.TextFrame.TextRange, _
           pFindTxt, pReplaceTxt
       End If
     Next
     End If
   On Error GoTo 0
   'Get next linked story (if any)
   Set rngStory = rngStory.NextStoryRange
 Loop Until rngStory Is Nothing
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngStory.Find
 .ClearFormatting
 .Replacement.ClearFormatting
 .Text = strSearch
 .Replacement.Text = strReplace
 .Execute Replace:=wdReplaceAll
End With
End Sub
Sub ResetFRParameters()
With Selection.Find
 .ClearFormatting
 .Replacement.ClearFormatting
 .Text = ""
 .Replacement.Text = ""
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 .Execute
End With
End Sub