Why isn't my code iterating through the tables in the word document?

Question

There is a strange behavior in the following code that I can't understand:

Even though we have the loop:

 For each tbl in doc.Tables
   ...
   ...
 Next tbl

The code is not iterating through the 6 tables in doc, but rather is "stuck" at the second table and adds all the data to that table, ignoring all the subsequent tables. I verified in the Interactive Window that all 6 tables are there. When I step through the code using F8, the code advances to Next tbl and loops back to the beginning of the block, but even so tbl still points to table 2, and the data continues to get added to table 2, even though it "should" be at table 3 by this point.

Public const kSchedRow = 12

Dim wd as New Word.Application
Dim doc as Word.Document
Set doc = wd.documents.open(myFile) 
Dim iTbl as integer 'Table #

iTbl = 1
For Each tbl In doc.Tables
    'skip first table in "Header" and last two tables in "footer"
    If Not (iTbl = 1 Or iTbl > doc.Tables.Count - 2) Then
        With Sheets(kVS) 'Excel sheet where the data resides to fill into Word Tables
            'Iterate through Excel table
            For Each rw In .Range(Cells(kSchedRow + 2, 1), Cells(kSchedRow + 2, 1).End(xlDown))
                'If the Excel data is intended for the current Word Table, then fill in data
                If .Cells(rw.Row, 1) = iTbl - 1 Then
                    With tbl.Rows
                        With .Last.Range
                            .Next.InsertBefore vbCr  'Insert Paragraph after end of table
                            .Next.FormattedText = .FormattedText  'Make the Paragraph a row in table
                        End With
                        With .Last
                             'Add the Excel data to the Word Table
                            .Cells(1).Range.Text = CDate(Sheets(kVS).Cells(rw.Row, 2)) & " - " & _
                                                        CDate(Sheets(kVS).Cells(rw.Row, 3)) 'Time
                            .Cells(2).Range.Text = Sheets(kVS).Cells(rw.Row, 4) 'Company
                            .Cells(3).Range.Text = Sheets(kVS).Cells(rw.Row, 5) 'Address
                            .Cells(4).Range.Text = Sheets(kVS).Cells(rw.Row, 6) 'Telephone
                            .Cells(5).Range.Text = Sheets(kVS).Cells(rw.Row, 10)
                        End With

                    End With
                End If
            Next rw
        End With
    End If
    iTbl = iTbl + 1
Next tbl

Any ideas what I'm doing wrong? I'm sure it's something very obvious, but I've been staring at the code for 4 hours and I just can't figure this out!

Answer 1

Since you're actualy using iTbl as the index of your tables, you'd better use Item property of Word.Tables collection to reference a table by its index

hence your code would be something like:

...
Dim wd As New Word.Application
Dim doc As Word.Document

...

Dim tbl As Word.Table '<-- full qualified explicit declaration
Dim iTbl As Long 'Table #

With doc.Tables ' reference word doc tables collection
    For iTbl = 2 To .Count - 2 'skip first table ("Header") and last two tables ("footer")
        For Each rw ...
                With .Item(iTbl).Rows '<-- use Item property of Word.Table object to address a table by its index
                    With .Last.Range
                        ...
                    End With
                    With .Last
                        ...
                    End With

                End With
            End If
        Next rw
    Next
End With

And, adopting all what already in comments and some more hints (see comments), it could become:

Option Explicit

Public Const kSchedRow As Long = 12 ' <-- full qualified explicit declaration

Sub MySub()

    Dim myFile As String, kVS As String '<-- explicit declaration

    myFile = ...
    kVS = ...

    Dim wd As New Word.Application
    Dim doc As Word.Document
    Set doc = wd.Documents.Open(myFile)

    Dim tbl As Word.Table '<-- full qualified explicit declaration
    Dim iTbl As Long 'Table #

    Dim rw As Range '<-- declaration of a (Excel) Range variable to loop throug an excel Range object
    Dim kVsRng As Range '<--  declaration of a (Excel) Range variable
    With Sheets(kVS) ' <-- Excel sheet where the data resides to fill into Word Tables
        Set kVsRng = .Range(.Cells(kSchedRow + 2, 1), .Cells(kSchedRow + 2, 1).End(xlDown)) '<-- set your excel range once and use it throughout the rest fo the code
    End With

    With doc.Tables ' reference word doc tables collection
        For iTbl = 2 To .Count - 2 'skip first table in "Header" and last two tables in "footer"
            'Iterate through Excel table wanted range
            For Each rw In kVsRng
                'If the Excel data is intended for the current Word Table, then fill in data
                If rw.Value = iTbl - 1 Then '< -- rw is already a cell in column 1, so use it directly
                    With .Item(iTbl).Rows '<-- use Item property of Word.Table object to address a table by its index
                        With .Last.Range
                            .Next.InsertBefore vbCr  'Insert Paragraph after end of table
                            .Next.FormattedText = .FormattedText  'Make the Paragraph a row in table
                        End With
                        With .Last
                             'Add the Excel data to the Word Table
                             ' <-- use column offsets from current rw cell to reach other cells in different columns of the same row
                            .Cells(1).Range.Text = CDate(rw.Offset(, 1).Value) & " - " & _
                                                        CDate(rw.Offset(, 2).Value) 'Time
                            .Cells(2).Range.Text = rw.Offset(, 3).Value 'Company
                            .Cells(3).Range.Text = rw.Offset(, 4).Value 'Address
                            .Cells(4).Range.Text = rw.Offset(, 5).Value 'Telephone
                            .Cells(5).Range.Text = rw.Offset(, 9).Value
                        End With

                    End With
                End If
            Next rw
        Next
    End With


    ...


End Sub

Answer 2

I can't vouch for my knowledge of Excel VBA, I'm much more comfortable with Word VBA.

There are two things that can be done to greately simplify the OP code.

1. From a Word perspective, use the correct Table collection

2. from a VBA perspective, separate the finding of a table from the populating of a table.

I have assumed that the need to exclude the header and footer tables mentioned means that the OP is not interested in Tables that appear in the Headers or Footers. This means that we can use the Word StoryRanges collection to select only those tables that appear in the main document body.

Thus

For Each tbl In doc.Tables

becomes

For Each tbl In myDoc.StoryRanges(wdMainTextStory).Tables

which, in turn, means we can eliminate the iTbl variable and the associated jiggery pokery in avoiding tables in the headers and footers. (I have highlighted one area in the code where I am not certain of this elimination)

I then used the refactor extract method of the fantastic and free Rubberduck addin for VBA to generate a new method that contained the code for copying a row and then revised this method to take a whole table range rather than just a row (PopulateTable).

I also used the .Add method for the Table.rows object as a simpler way of adding a row to a table.

I've no idea if the code below will function as intended by the OP code but it does compile and does not have any Rubberduck inspection results so at least it is syntactically correct.

I hope that the code below demonstrates how getting a better understanding of the Word object model, and the separation of concerns (finding a table and populating a table are two different activities) allows simpler/cleaner code.

Option Explicit

Public Const kSchedRow As Long = 12

Public Sub PopulateTables(ByVal ipFileName As String)

    Dim wdApp As Word.Application
    Set wdApp = New Word.Application

    Dim myDoc As Word.Document
    Set myDoc = wdApp.Documents.Open(ipFileName)

    Dim tbl As Word.Table
    ' Use the StoryRanges collection to select the correct range for the tables we want to populate
    For Each tbl In myDoc.StoryRanges.Item(wdMainTextStory).Tables
        With ThisWorkbook.Sheets("kVs") 'Excel sheet where the data resides to fill into Word Tables

            ' Define the excel range to be copied
            Dim CopyRange As Excel.Range
            Set CopyRange = .Range(.Cells(kSchedRow + 2, 1), .Cells(kSchedRow + 2, 1).End(xlDown))

            ' We are now copying tables from the main content of the document
            ' so I think this test is now redundant

            'If .Cells(rw.Row, 1) = iTbl - 1 Then '
            PopulateTable tbl, CopyRange
            ' End if
        End With
    Next tbl

End Sub

Public Sub PopulateTable(ByVal ipTable As Word.Table, ByVal ipCopyRange As Excel.Range)

    Dim rw As Excel.Range
    For Each rw In ipCopyRange
        With ipTable.Rows

            ' add a row at the bottom of the table
            .Add

            'Add the Excel data to the Word Table
            With .Last
                .Cells.Item(1).Range.Text = CDate(rw.Cells.Item(rw.Row, 2)) & " - " & _
                                            CDate(rw.Cells.Item(rw.Row, 3)) 'Time
                .Cells.Item(2).Range.Text = rw.Cells.Item(rw.Row, 4) 'Company
                .Cells.Item(3).Range.Text = rw.Cells.Item(rw.Row, 5) 'Address
                .Cells.Item(4).Range.Text = rw.Cells.Item(rw.Row, 6) 'Telephone
                .Cells.Item(5).Range.Text = rw.Cells.Item(rw.Row, 10)
            End With

        End With

    Next

End Sub