VBA create bulk Word docs from Excel

[floggingmolly]

I am trying to create a VBA code to fill in Word documents from an Excel sheet. The code is only replacing Variable 1 in the Word document and saving it. I can't figure out why it's not replacing the other variables that are in the code. Any suggestions would be appreciated.

CreateLetters()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WordRange As Object
    Dim ExcelWS As Worksheet
    Dim ExcelWB As Workbook
    Dim LastRow As Long
    Dim i As Long
    Dim WordDocPath As String
    Dim SaveFolder As String
    
    ' Prompt the user to select a Word document
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select Word Document"
        .Filters.Add "Word Files", "*.docx,*.doc"
        If .Show = -1 Then
            WordDocPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' Prompt the user to select a folder for saving Word documents
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Save Folder"
        If .Show = -1 Then
            SaveFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' Open the selected Word document
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
    Set WordDoc = WordApp.Documents.Open(WordDocPath)
    
    ' Set the Excel workbook and worksheet with your data
    Set ExcelWB = ThisWorkbook ' or specify your Excel workbook path
    Set ExcelWS = ExcelWB.Worksheets("Sheet1") ' Update with your sheet name
    
    ' Find the last row with data in column B (assuming all columns have the same number of rows)
    LastRow = ExcelWS.Cells(ExcelWS.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through the data in Excel and replace placeholders in the Word document
    For i = 4 To LastRow
        Set WordRange = WordDoc.Content
        WordRange.Find.Execute FindText:="<VARIABLE 1>", ReplaceWith:=ExcelWS.Cells(i, 2).Value
        WordRange.Find.Execute FindText:="<VARIABLE 2>", ReplaceWith:=ExcelWS.Cells(i, 3).Value
        WordRange.Find.Execute FindText:="<VARIABLE 3>", ReplaceWith:=ExcelWS.Cells(i, 4).Value
        WordRange.Find.Execute FindText:="<VARIABLE 4>", ReplaceWith:=ExcelWS.Cells(i, 5).Value
        WordRange.Find.Execute FindText:="<VARIABLE 5>", ReplaceWith:=ExcelWS.Cells(i, 6).Value
        WordRange.Find.Execute FindText:="<VARIABLE 6>", ReplaceWith:=ExcelWS.Cells(i, 7).Value
        ' Repeat this for other variables
        
        ' Save the Word document with a new name in the specified folder
        WordDoc.SaveAs2 SaveFolder & "\" & "Letter_" & i & ".docx"
        WordDoc.Close False
    Next i
    
    ' Clean up and close Word
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub
[\code]

 

[floggingmolly]

I was able to figure it out. This has been resolved, no need to reply. Thank you

 

[Fluff]

Good to hear you got the solution.
If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.
Thanks