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

DThib

Active Member
Joined
Mar 19, 2010
Messages
464
Office Version
  1. 365
Platform
  1. Windows
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:

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Forum statistics

Threads
1,224,823
Messages
6,181,173
Members
453,021
Latest member
Justyna P

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
Back
Top