The following modified code will display a message box that allows the user
to select either the default file containing the replacements or if they
click on the No button, it will display the File>Open dialog so that they
can select a file to be used.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim SourceFile As String
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to
be made
Dim Msg, Style, Title, Response
Msg = "Do you want to use the default replacements file ?"    ' Define
message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
Title = "Select Source File"    ' Define title.
       ' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then    ' User chose Yes.
   Set Source = Documents.Open("c:\documents\source.doc") 'Open the
document containing the table of
'replacements to be made. It assumes that there is a header row in the
table.
'Modify the path and filename to suit.
Else    ' User chose No. Display the FileOpen dialog
   With Dialogs(wdDialogFileOpen)
       If .Display <> -1 Then
           SourceFile = ""
           MsgBox "You did not select a file."
           Exit Sub
       Else
           SourceFile = WordBasic.FileNameInfo$(.Name, 1)
       End If
       Set Source = Documents.Open(SourceFile) 'Open the selected document
   End With
End If

With Source.Tables(1)
   For i = 2 To .Rows.Count
       Set sFindText = .Cell(i, 1).Range
       sFindText.End = sFindText.End - 1
       Set sReplText = .Cell(i, 2).Range
       sReplText.End = sReplText.End - 1
       Target.Activate
       With Selection.Find
           .Forward = True
           .Wrap = wdFindContinue
           .MatchWholeWord = True
           .MatchWildcards = False
           .MatchSoundsLike = False
           .MatchAllWordForms = False
           .Format = True
           .MatchCase = False
           .Text = sFindText
           .replacement.Text = sReplText
           .Execute Replace:=wdReplaceAll
       End With
   Next i
End With
Source.Close wdDoNotSaveChanges
Target.Activate

End Sub

Ann Marie,

I didn't test in Doug's code, but to use it in Find and Replace you
would do something like:

Sub FillArrayThenFindandReplace()
Dim myArray() As String
Dim oDoc As Word.Document
Dim i As Long
Dim j As Long
Dim pRow As Long
Dim oTbl As Word.Table
Dim oRng As Word.Range
Set oDoc = Documents.Open("C:\Word List.doc")
Set oTbl = oDoc.Tables(1)
ReDim myArray(oTbl.Rows.Count - 2, 1) 'Size the array
For pRow = 2 To oTbl.Rows.Count 'Start with 2 to skip the header row
 For i = 1 To 2
   myArray(pRow - 2, i - 1) = Left(oTbl.Cell(pRow, i), _
         Len(oTbl.Cell(pRow, i).Range.Text) - 2)
 Next
Next
oDoc.Close
Set oRng = ActiveDocument.Range
For pRow = 0 To UBound(myArray)
 With oRng.Find
   .Text = myArray(pRow, 0)
   .Replacement.Text = myArray(pRow, 1)
   .Execute Replace:=wdReplaceAll
  End With
Next
End Sub

I have posted an Addin on my website that I created with the help of
Doug and others that you might be interested in:

http://gregmaxey.mvps.org/VBA_Find_And_Replace.htm