For each loop instantly jumps to the last result

Question

I am trying to make code to run through word document containing repeating section content controls (RepSecCC) containing several nested CC's inside. I want write macro which for each RepSecCC would generate new Word document (from template) and populate it with info from nested CC's.

Problem that my current code generates only one document and populates it with info from last RepSecCC. I can't figure out why it skips all the other RepSecCC. Where I should adjust my code?

    Dim objWord As Object
    Dim objDoc As Object
    Dim pack As String, Reg_No As String, VP_name As String, 
    Dim CC As Word.ContentControl
    Dim rCC As Word.ContentControl

    Set objWord = CreateObject("Word.Application")

    MsgBox "Document's are generated. Please wait"

    For Each rCC In ActiveDocument.ContentControls

        If rCC.Title = "New_section" Then

            For Each CC In rCC.Range.ContentControls
                If CC.Tag = "LI_NO" Then
                    Reg_No = CC.Range.Text
                ElseIf CC.Tag = "VP_pav" Then
                    VP_name = CC.Range.Text
                ElseIf CC.Tag = "Pack" Then
                    pack = CC.Range.Text
                    pack = UCase(Left(pack, 1)) & Mid(pack, 2)
                End If
            Next CC

            Set objDoc = objWord.Documents.Add(Template:="S:\bendri\VRS\VRS Administravimas\6 Lygiagretus importas\LI registracijos sarasas\LI_sablonasM.dotm", NewTemplate:=False, DocumentType:=0)
            objWord.Visible = True

            With objDoc
                .ContentControls.Item(1).Range.Text = Reg_No
                .ContentControls.Item(2).Range.Text = VP_name
                .ContentControls.Item(4).Range.Text = pack
            End With
        End If
    Next rCC

    MsgBox "Finished. Please continue"

End Sub

Answer 1

I figured it out myself, turns out, my initial code had two problems:

1) second For each...next loop was going through every CC and adjusting variables till it reaches last CC and variable value remains unchanged. Because of that, my document was receiving only info from the last section.

2) another problem was caused by the fact, that for some reason repeating CC sections was not considered as separate objects and because of that, whole repeating CC was counted as one, so in turn only one document was being created.

I managed to overcome these problems by changing whole code working principle:

Firstly for each relevant CC I created New Collection then I looped through all the document and added these CC values to appropriate collections.

Then, I looped through document again and for each CC with specific tag created new document, which took values from Collections. Since values in collection was in sequential order I just add counter, which counted loop number and by that determined which value from collection to use.

I am sure it is probably not the most efficient way, but it works and works with satisfactory speed.

My final code, maybe someone can make use of it:

Public Sub generate_docs()

    Dim objWord As Object
    Dim objDoc As Object
    Dim pack As New Collection, Reg_number As New Collection, VP_name As New Collection, Client As New Collection
    Dim Number As String
    Dim CC As Word.ContentControl
    Dim TagCC As Word.ContentControl
    Dim ccRepSec As Word.ContentControl
    Dim i As Long
    Dim x As String

    i = 0

    Set objWord = CreateObject("Word.Application")
    Set ccRepSec = ActiveDocument.SelectContentControlsByTitle("Nauja registracija").Item(1)

    MsgBox "Documents are being generated. Please wait"

    For Each CC In ccRepSec.Range.ContentControls
        If CC.Tag = "LI_NO" Then
            x = CC.Range.Text
            Reg_number.Add Item:=x
        ElseIf CC.Tag = "VP_pav" Then
            x = CC.Range.Text
            VP_name.Add Item:=x
        ElseIf CC.Tag = "Par_pav" Then
            x = CC.Range.Text
            Client.Add Item:=x
        ElseIf CC.Tag = "Package" Then
         'I needed for value to start in upper case, and since in original document its written in lower case used this code
            x = CC.Range.Text
            x = UCase(Left(x, 1)) & Mid(x, 2)
            pack.Add Item:=x
        End If
    Next CC

    For Each TagCC In ccRepSec.Range.ContentControls
        If TagCC.Tag = "LI_NO" Then
            i = i + 1
            Set objDoc = objWord.Documents.Add(Template:="S:\shared\LI\LI_template.dotm", NewTemplate:=False, DocumentType:=0)
            objWord.Visible = True

            With objDoc

                .ContentControls.Item(1).Range.Text = Reg_number(i)
                .ContentControls.Item(2).Range.Text = VP_name(i)
                .ContentControls.Item(5).Range.Text = Client(i)
                .ContentControls.Item(4).Range.Text = pack(i)

                ' I wanted for name to have middle part of Reg_number variable so used code below, to extract it
                Number = Split(Reg_number(i), "/")(3)
                NewFileName = Number & Format(Now, "_yyyy-mm-dd") & ".docx"
                'I wanted to save documents in the same place as original document is located
                .SaveAs2 FileName:=Application.Documents(Application.Documents.Count).Path & "\\" & NewFileName
            End With
        End If
    Next TagCC

    MsgBox "Documents are created. Continue."

End Sub