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

DThib

Active Member
Joined
Mar 19, 2010
Messages
429
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:
Code:
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
 
Last edited:

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Watch MrExcel Video

Forum statistics

Threads
1,127,463
Messages
5,624,877
Members
416,064
Latest member
PaulBr2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top