[SOLVED] Inserting content from Excel into Word using VBA overwrites content previously inserted

Inserting content from Excel into Word using VBA overwrites content previously inserted

I have written a VBA macros in Excel to read data from Excel and create a document in Word. It works in "sections". When I add text using instructions of format below it works:

objSelection.TypeText lenderAddress & vbCrLf

But then when I create a Table and populate from cell data the early text content is deleted (or over written). The same issue is after the Table when I try to insert more text (as a combination of cell values but not within the Table) it corrupts the table format and inserts above the table.

I am running Office 16.78.3 on a Mac.

HERE is what I have:

Sub GenerateWordDoc()
    Dim ws As Worksheet
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim objSelection As Object
    Dim lastRow As Long
    Dim lenderName As String
    Dim i As Long
    Dim addressFound As Boolean
    Dim subtotal As Double
    Dim selectedLender As String
    Dim lenderAddress As String
    
    ' Set worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Get last row of data
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Prompt user to select lender
    selectedLender = Application.InputBox("Select Name", "Name Selection", Type:=2)
    
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0

    ' If Word is not running, create a new instance
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If    
    Set wdDoc = wdApp.Documents.Add
    Set objSelection = wdApp.Selection
   
   ' Make Word visible
    wdApp.Visible = True
    wdApp.Activate

    ' Write  Name to Word document
    objSelection.TypeText selectedLender & vbCrLf
   
    ' Summarize entries for the selected Lender
    objSelection.TypeText "Summary of Loans:" & vbCrLf & vbCrLf
    wdDoc.Tables.Add wdDoc.Content, 1, 3
    wdDoc.Tables(1).Cell(1, 1).Range.Text = "DATE"
    wdDoc.Tables(1).Cell(1, 2).Range.Text = "AMOUNT"
    wdDoc.Tables(1).Cell(1, 3).Range.Text = "TYPE"

    Dim rowCount As Integer
    rowCount = 2

    ' For i = 2 To lastRow
    For i = 2 To 18
        If ws.Cells(i, 5).Value = selectedLender Then
            wdDoc.Tables(1).Rows.Add
            wdDoc.Tables(1).Cell(rowCount, 1).Range.Text = ws.Cells(i, 1).Value
            wdDoc.Tables(1).Cell(rowCount, 2).Range.Text = ws.Cells(i, 8).Value
            wdDoc.Tables(1).Cell(rowCount, 3).Range.Text = ws.Cells(i, 7).Value
            subtotal = subtotal + ws.Cells(i, 8).Value
            rowCount = rowCount + 1
        End If
    Next i
    
    ' Add subtotal
    wdDoc.Content.Text = "Subtotal: " & subtotal
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
End Sub

Solution

The problem is this line:

wdDoc.Tables.Add wdDoc.Content, 1, 3

wdDoc.Content is a range that represents the entire body of the document. Adding a table to this range replaces the content. See https://learn.microsoft.com/en-us/office/vba/api/word.tables.add

As I assume you want the table to appear at the end of the document, use this instead:

wdDoc.Tables.Add wdDoc.Characters.Last, 1, 3