Push data from excel to a word document

Question

I am trying to push excel data to a word document. The word document is a pre-existing document that needs to be filled in with values and a lot IDs. I have the word document set up so that all the spots that need data filled in from excel are Rich Content Controls. I inserted the Rich Content Control to each spot on the document that needs to be filled.

[![enter image description here][1]][1] Excel Data

Only pasted 10 rows for sample data.

[![enter image description here][2]][2]

Word Document. Rich Content Controls in "Weight" Column and "Lot" Column

What I want to accomplish is to push the "weights" from the excel spreadsheet into the "weight" column on the word document and push the "bulk lot" from the excel spreadsheet into the "lot" column of the word document.

Sub PushDatatoWord()
  'Declare the appropriate variables
  Dim wordApp As Word.Application
  Dim wDoc As Word.Document
  Dim r As Integer

'Create a link to the microsoft word application
  Set wordApp = CreateObject("word.application")
'Create variable of the word document
Set wDoc = wordApp.Documents.Open("Worddoc.docx")
wordApp.Visible = True
r = 2

For i = 1 To 20
    wDoc.ContentControls(i).Range.Text = Sheets("Boxes_Push").Cells(r, 3)
    r = r + 1
Next i

wordApp.Documents.Close
wordApp.Quit

End Sub

Above is the code that I have written, it pushes the values but it doesn't put them all into the correct column, the code is looping through all the content controls on the word document and placing the values in the next control. How do I separate the content controls on the word document so I can send the data to the appropriate column??

EDIT TO ORIGINAL POST:

[,[Excel Worksheet with a range from B2,C15][3]][3]

[![Word Document with named content controls][4]][4]

'1. Name all content controls on word document. weight1, weight2, weight3, etc. lot1, lot2, lot3, etc.
'2. Create a 2d array with the values and lot . Read range values to arrary.
'3. Use SelectContentControlsByTitle() in a foreach loop with the array created.


Sub dataToWord()

    Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim r As Long
    Dim arr As Variant
        
    'create connection to the word application
    
    Set wordApp = CreateObject("word.application")
    
    'Set the word document, content controls named weight1, weight2, etc and lot1, lot2, etc
    
    Set wDoc = wordApp.Documents.Open("C:\Users\tyler.masson\Desktop\PushToWord\testpush_withnames.docx")
    wordApp.Visible = True
    r = 2
 
    'range created on worksheet from cells B2,C15 called "range"
    arr = Range("range").Value
    For Each i In arr
        wDoc.SelectContentControlsByTitle(Weight).Range.Text = Sheets("testpush").Cells(r, 2)
        r = r + 1
        
    Next i
    
   
    wordApp.Documents.Close
    wordApp.Quit


End Sub

I'm having trouble with the for each loop. I'm not entirely sure how to loop through each content control by title (weight and lot?) and then to assign the values in the created array to those content controls.

I really appreciate help on this. [1]: https://i.stack.imgur.com/Nb4e8.png [2]: https://i.stack.imgur.com/tsvaM.png [3]: https://i.stack.imgur.com/eyNuj.png [4]: https://i.stack.imgur.com/E6G0c.png

Answer 1

Something like this should work:

Sub dataToWord()

    Dim wordApp As Word.Application
    Dim wDoc As Word.document, tbl As Word.Table
    Dim r As Long, c As Long, maxRows As Long, i As Long
    Dim arr As Variant
        
'    Set wordApp = CreateObject("word.application")
'    Set wDoc = wordApp.Documents.Open("C:\Users\tyler.masson\Desktop\PushToWord\testpush_withnames.docx")
'    wordApp.Visible = True
    
    'using an already-open doc for testing
    Set wordApp = GetObject(, "word.application")
    Set wDoc = wordApp.activeDocument
    
    Set tbl = wDoc.Tables(1) 'assuming just one table

    r = 2
    c = 2
    maxRows = 10 'how many rows in the first set of columns
                 '  before we need to move over to the next set?

    'maxRows = tbl.Rows.Count - 1 'dynamic count
    
    'range created on worksheet from cells B2,C15 called "range"
    arr = Range("range").Value
    For i = LBound(arr, 1) To UBound(arr, 1)
        'put the values directly in the cells
        tbl.Cell(r, c).Range.Text = arr(i, 1)
        tbl.Cell(r, c + 2).Range.Text = arr(i, 2)
        
        'time to switch to next column?
        If i = maxRows Then
            c = c + 5
            r = 2
        Else
            r = r + 1
        End If
        
    Next i
End Sub