Find/Replace macro from excel into Word

[Matt]

All:

I am running a macro from excel that opens a word document on c:\
directory and does a find and replace in the word document from the
criteria in certain cells in the excel file. Where I am having trouble
is with the find and replace information. I have set up a loop to save
on code and calls a second sub. I am getting a debug issue when it
calls the second sub called Sub DoFindReplace(...). Can someone tell
me what is wrong with this sub or is there something wrong with the
first sub. If I have left something out or you need more information
let me know and I will respond. Thanks in advance.
~Matt


Private Sub CommandButton2_Click()

Dim sCustomer As String
Dim sJobDate As String
Dim sLease As String
Dim sVessel As String
Dim sTreatment As String
Dim sField As String
Dim sFormation As String
Dim sWellNo As String
Dim sPE_SalesOrderNo As String
Dim sPeEngr1 As String
Dim sCustomerEngr As String
Dim sAccountRep As String
Dim appWD As Object
Set appWD = CreateObject("Word.Application")


Sheets("SC Database").Activate
sCustomer = ActiveSheet.Range("Customer")
sJobDate = ActiveSheet.Range("JobDate")
sLease = ActiveSheet.Range("Lease")
sVessel = ActiveSheet.Range("Vessel")
sTreatment = ActiveSheet.Range("Treatment")
sField = ActiveSheet.Range("Field")
sFormation = ActiveSheet.Range("Formation")
sWellNo = ActiveSheet.Range("Well")
sPE_SalesOrderNo = ActiveSheet.Range("PE_SalesOrderNo")
sPeEngr1 = ActiveSheet.Range("PeEngr1")
sCustomerEngr = ActiveSheet.Range("CustomerEngr")
Sheets("Input").Activate
sAccountRep = ActiveSheet.Range("AccountRep")


appWD.Visible = True
appWD.Documents.Open Filename:="C:\CD Jewel Case Label.doc"


'Remove Date with correct job information
Call DoFindReplace(FindText:="Date", ReplaceText:=sJobDate)
MsgBox "Is this working? " & sCustomer, vbOKOnly, "Is this
working?"
'Remove Lease with correct job information
Call DoFindReplace(FindText:="Lease", ReplaceText:=sLease)
'Remove Vessel with correct job information
Call DoFindReplace(FindText:="Vessel", ReplaceText:=sVessel)
'Remove Treatment with correct job information
Call DoFindReplace(FindText:="Treatment", ReplaceText:=sTreatment)
'Remove Field with correct job information
Call DoFindReplace(FindText:="Field", ReplaceText:=sField)
'Remove Formation with correct job information
Call DoFindReplace(FindText:="Formation", ReplaceText:=sFormation)
'Remove Well with correct job information
Call DoFindReplace(FindText:="Well", ReplaceText:="Well # " &
sWell)
'Remove Sales Order with correct job information
Call DoFindReplace(FindText:="Sales Order", ReplaceText:="SO# " &
sPE_SalesOrderNo)


' Brings cursor to top of page.
Selection.HomeKey Unit:=wdStory


End Sub


Sub DoFindReplace(FindText As String, ReplaceText As String)


With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = FindText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
'Keep going until nothing found
.Execute Replace:=wdReplaceAll
Loop
'Free up some memory
'ActiveDocument.UndoClear
End With

End Sub