Looping is killing my Excel 365 VBA code!

DThib

Active Member
Joined
Mar 19, 2010
Messages
424
Hello.

I have written the below code and it works to create the the correct name and place that value in a Word doc Content Control and then add to the 2 tables the correct information.

My problem is that it is also adding other lines instead of just the code that matches the column 6 code.
There should be 4 individuals with no matches, 2 matches grouped with 4037424 and 7 matches with 4036202.

Here is the code:
Code:
Sub Mud()


    Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim RPs As Worksheet
    Dim LRow As Long, bug As Variant
    Dim i As Variant
    Dim nob As Variant
    Dim First As Word.Table
    Dim Second As Word.Table
    
    'used by/for dictionary
    Dim lr As Long, X As Long
    Dim dic As Object
    Dim arr As Variant, key As Variant
    
    'load dictionary with Uniques From Column D 
    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
    LRow = Sheets("Released Product").Cells(Rows.Count, "A").End(xlUp).Row 'Sterile PO #
   ' bug = RPSort 'Batch/Lot #
    
     i = LRow


     Doc_Land = "C:\Location\"


     Set RPs = ThisWorkbook.Sheets("Released Product")
     
     Set wordApp = CreateObject("Word.Application")
     Set wDoc = wordApp.Documents.Open(Doc_Land & RPs.Range("P31") & ".docx") '"\" & , , False
     wordApp.Visible = True
      
      Set First = wDoc.Tables(1)
      Set Second = wDoc.Tables(2)
        
        For Each key In dic.keys
             For i = 3 To LRow 'To 1 Step -1          'work from the bottom up
                  If RPs.Cells(i, 6).Value = key And RPs.Cells(i, 1).Value = RPs.Range("O1") Then
                     wDoc.Activate
                     
                     wDoc.ContentControls(1).Range.Text = RPs.Cells(i, 6).Value  'Sterile PO#
                     
                        '1st Form
                           First.Rows.Add
                           First.Cell(First.Rows.Count, 1).Range.Text = RPs.Cells(i, 9).Value   'Sterile Prod Name
                           First.Cell(First.Rows.Count, 2).Range.Text = RPs.Cells(i, 8).Value   'Sterile Part #
                           First.Cell(First.Rows.Count, 3).Range.Text = RPs.Cells(i, 11).Value  'Test Report #
                           '2nd Form
                           Second.Rows.Add
                           Second.Cell(Second.Rows.Count, 1).Range.Text = RPs.Cells(i, 8).Value  'Sterile Part #
                           Second.Cell(Second.Rows.Count, 2).Range.Text = RPs.Cells(i, 11).Value 'Test Report #
                           Second.Cell(Second.Rows.Count, 3).Range.Text = RPs.Cells(i, 4).Value  'Lot #


                      wDoc.SaveAs Doc_Land & "BET - " & RPs.Cells(i, 6), wdFormatPDF
                  
                    Set wDoc = Nothing
                    Set wDoc = wordApp.Documents.Open(Doc_Land & RPs.Range("P31").Value & ".docx", , False)
                 End If
                    'Set wDoc = Nothing
                    'wDoc.SaveAs Doc_Land & "/" & RPs.Cells(i, 6), wdFormatDocumentDefault
                    ' wDoc.SaveAs Doc_Land & "/" & RPs.Cells(i, 6), wdFormatPDF
                    '.SaveAs Doc_Land & "BET - " & RPs.Cells(i, 6), wdFormatPDF 
              Next i
        Next key
wordApp.Documents.Open(Doc_Land & RPs.Range("P31").Value & ".docx", , False) '"\" &


     
      MsgBox "All Forms complete!", vbCritical + vbExclamation + vbOKOnly, "BET Release 1001"
   
End Sub
Help!
 
Last edited:

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,288
Have you checked what's in the dictionary before you start transferring data to Word?
 

DThib

Active Member
Joined
Mar 19, 2010
Messages
424
Yes. I have it keying off of the column 6 data. I can also have it pull off the individual ids in column 4.


Right now it is pulling off of column 6.
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,288
What do you mean by 'adding other lines'?
 

DThib

Active Member
Joined
Mar 19, 2010
Messages
424
Hi Norie,

When I run the code you can see in my string, I produce the 6 PDFs labeled with the PO and the Word doc Content Control showing. Then the code shows the results for the PO group and also several results from a different PO. The data is from the Excel table but it is not defining the data to include by the PO # only.

Does that help?

DThib
 
Last edited:

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,288
Not sure what string you mean, and I can't see your data I'm afraid.:)

Have you tried stepping through the code and checking what data is actually being pulled from Excel?

PS Do you have any merged cells?
 

DThib

Active Member
Joined
Mar 19, 2010
Messages
424
Yes.

Every time I step through the code at the code:

wordApp.Visible = True

It pauses and runs, not stopping, to produce the results. But until then it is doing everything right.

I do not have any merged cells in the table
 
Last edited:

DThib

Active Member
Joined
Mar 19, 2010
Messages
424
It appears to look at the table find the matching PO# and stop copying at that point instead of copying only the matching PO # rows.
 

Forum statistics

Threads
1,078,393
Messages
5,339,923
Members
399,340
Latest member
JasonT903

Some videos you may like

This Week's Hot Topics

Top