Excel 365 macro to add row to Word 365 for with Content Controls

[DThib]

My data is supposed to loop through a list find the matching cell(s) defined by the dictionary and add content to content controls on a word document.

The code below works, but it will not place the next match in the next row on Word 365 doc or trigger the content control to include a row, (There is coding in the word template to setup another row when the last content control in row is finished with enter).
Can anyone help?

Code below:

Sub Mud()


    Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim RPs As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim CCs As ContentControls
    'used by/for dictionary
    Dim lr As Long, X As Long
    Dim dic As Object
    Dim arr As Variant, key As Variant, Bob As Variant


    'load dictionary with Uniques From Column D "Lot/Batch [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=s"]#s[/URL] "
    With Sheets("Released Product")
      lr = .Range("F" & .Rows.Count).End(xlUp).Row
      arr = .Range("F2:F" & lr)
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    For X = 1 To UBound(arr, 1)
      dic(arr(X, 1)) = 1
    Next X
    
    Application.ScreenUpdating = False
            Nextrow = Sheets("Released Product").Cells(Rows.Count, "F").End(xlUp).Row 'Batch/Lot #
            LastRow = Sheets("Released Product").Cells(Rows.Count, "D").End(xlUp).Row 'Batch/Lot #
            i = 1 + LastRow
            Bob = 1 + Nextrow
     Doc_Land = "\\server"
    

     Set RPs = ThisWorkbook.Sheets("Released Product")
     Set wordApp = CreateObject("Word.Application")
     Set wDoc = wordApp.Documents.Open(Doc_Land & "" & Range("N31") & ".docm")
     wordApp.Visible = True


        For Each key In dic.keys
               For i = LastRow To 1 Step -1    'work from the bottom up
                 If RPs.Cells(i, 6) = key And RPs.Cells(i, 1).Value = RPs.Range("O1") Then
                    wDoc.ContentControls(1).Range.Text = RPs.Cells(i, 6).Value   'Sterile PO#
                  'Do While Bob = wDoc.ContentControls(1).Range.Text
                      With wDoc
                       '.ContentControls(1).Range.Text = RPs.Cells(i, 6).Value   'Sterile PO#
                       .ContentControls(2).Range.Text = RPs.Cells(i, 9).Value   'Sterile Prod Name
                       .ContentControls(3).Range.Text = RPs.Cells(i, 8).Value   'Sterile Part #
                       .ContentControls(4).Range.Text = RPs.Cells(i, 17).Value  'Test Report #
                    
                       .ContentControls(5).Range.Text = RPs.Cells(i, 8).Value  'Sterile Part #
                       .ContentControls(6).Range.Text = RPs.Cells(i, 17).Value  'Test Report #
                       .ContentControls(7).Range.Text = RPs.Cells(i, 4).Value   'Lot #
                      ' .SaveAs Doc_Land & "/" & RPs.Cells(i, 16), wdFormatDocumentDefault
                       '.SaveAs Doc_Land & "/" & RPs.Cells(i, 6), wdFormatPDF
                      End With
                 'Loop


                   wDoc.SaveAs Doc_Land & "/" & RPs.Cells(i, 6), wdFormatPDF
                  Set wDoc = Nothing
                  Set wDoc = wordApp.Documents.Open(Doc_Land & "" & Range("N31").Value & ".docm")
                    wDoc.Activate
                 End If
               Next i
        Next key


     MsgBox "All Forms complete!", vbCritical + vbExclamation + vbOKOnly, "Release 1001"
     wordApp.Documents.Close
     wordApp.Quit
   
End Sub

Anyone?
This is an immediate need

DThib

 

[DThib]

Bump!