Looping is killing my Excel 365 VBA code!

DThib

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

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Have you checked what's in the dictionary before you start transferring data to Word?
 
Upvote 0
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.
 
Upvote 0
What do you mean by 'adding other lines'?
 
Upvote 0
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:
Upvote 0
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?
 
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
Do you have any merged cells in Excel?
 
Upvote 0

Forum statistics

Threads
1,213,495
Messages
6,113,992
Members
448,538
Latest member
alex78

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