Finding multiple instances of multiple words in Word using VBA - excel

Question

I am writing a VBA code to enter a user form and then transfer that data from the Excel sheet to an already existing Word document.
My Excel part is ok.
My document contains various words like Batch No, Manufacturing date, etc. each many times. I will have to find these words and insert Batch No and Manufacturing date from the user form every time they are found in the whole document.
Initially, I tried to find a single word in the whole document, but my sub routine can find only the first instance and is not finding similar words in rest of the document.
Please help
Sub Copy_data2()
Dim my_filename As Variant
Dim my_filenameword As Variant
Dim objselection As Object
'Word Variables
Dim mres As String
Dim oword As Object
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim bfound As Boolean
Dim rngDoc As Word.Range
Dim rngSearch As Word.Range
'Excel Variables
Dim wkbk As Workbook
Dim irow As Long
Dim txtSl As String
Dim txtBNo As String
Dim txtPr As String
Dim txtBS As String
Dim txtMfD As String
Dim txtExD As String
Dim workinglocation As String
Dim workingfilename As String
Dim workingdir As String
Dim ret As Boolean
Dim VbRes As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'--------------------------------------------------------------------------------------------
'Excel extract values
'------------------------------------------------------------------------------------------
VbRes = MsgBox("Please select the Requisition sheet", vbOKOnly + vbInformation, "Select the requisition file")
my_filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls*")
Set wkbk = Workbooks.Open(my_filename)
txtPr = FrmMaster.CmbProduct.Text
txtBNo = FrmMaster.txtBatchNo
txtBS = FrmMaster.txtBatchSize
txtMfD = FrmMaster.txtMfgDate
txtExD = FrmMaster.txtExpDate
wkbk.Sheets("Requisition").Range("C9") = txtBNo
wkbk.Sheets("Requisition").Range("G9") = txtBS
wkbk.Sheets("Requisition").Range("C10") = txtMfD
wkbk.Sheets("Requisition").Range("G10") = txtExD
irow = [Counta(Database!A:A)]
ThisWorkbook.Sheets("Database").Cells(irow, 1) = txtSl
Debug.Print txtSl
'-------------------------------------------------------------------------------------------------
'VB Word
'----------------------------------------------------------------------------------------------
mres = MsgBox("Select the Word BMR", vbOKOnly + vbInformation, "Select BMR")
my_filenameword = Application.GetOpenFilename(FileFilter:="Word Files,*.doc*")
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
wdApp.Activate
Set wdDoc = wdApp.Documents.Open(my_filenameword)
wdDoc.Activate
With wdApp.Selection.Range.Find
.ClearFormatting
.Text = "BATCH SIZE"
bfound = .Execute(Forward:=True)
Do While bfound = True
'.Move Unit:=wdCharacter, Count:=4
.Text = "BATCH SIZE"
.Replacement.Text = "Size"
Loop
End With
my_filenameword.Close True
wkbk.Close True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

Answer 1

You really should spend a few moments studying Find/Replace in Word. Even the macro recorder there would give you most of the code you need. Try:
Set wdDoc = wdApp.Documents.Open(my_filenameword, , False, False, , , , , , , , False)
With wdDoc
With .Range.Find
.Forward = True
.Wrap = wdFindContinue
.Text = "BATCH SIZE"
.Replacement.Text = "Size"
.Execute Replace:=wdReplaceAll
End With
.Close True
End With
As you can see, no looping is required - just a proper application of Find/Replace.