How to compile text from multiple tables into a cell in a nested table

jrooney7 · #1 03-09-2019, 08:20 PM

Hello all, I have a word document (*.dotm) that has an unknown number of tables, some of which have a first row containing the word "Worksheet" - e.g. "Firearm Worksheet", "Bullet Worksheet", etc. (see Example Table.png). I have a final table in the document, whose format I have no control over. It is a table with 3 rows and 3 columns. The second column of each row has a nested table that is 1 row with 3 columns (see Results Table.png) I have created a macro whose purpose is to compile the results (last row) of any table containing the word "Worksheet" in the first row into the second column of the nested table in the second row of the results table. When I run this macro, the result is what you see in Results Table after Macro.png, but it should be what you see in Results Table correct.png. The macro I have written is:

Code:

Sub Results()
'
' Results Macro
'
'
    Dim LastTable As Integer
       LastTable = ActiveDocument.Range.Tables.Count
    Dim currentTableIndex As Integer
       currentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
    Dim NumberOfRowsInCurrentTable As Integer
       NumberOfRowsInCurrentTable = ActiveDocument.Tables(currentTableIndex).Rows.Count
    
    Dim t As Table
    
    For Each t In ActiveDocument.Tables
        t.Cell(1, 1).Range.Select
        Selection.Find.Execute FindText:="Worksheet"
        If Selection.Find.Found = True Then
            t.Cell(NumberOfRowsInCurrentTable, 1).Range.Select
            Selection.Range.Copy
            ' this section is for when the destination cell in the Results Table is empty
            If Len(ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Text) < 3 Then
                ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Select
                Selection.Paste
            End If
            ' this section is for when destination cell in the Results Table already contains text
            If Len(ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Text) > 2 Then
                ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Select
                Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                Selection.TypeParagraph
                Selection.TypeParagraph
                Selection.Paste
            End If
        End If
    Next
        
End Sub

Additionally, when I ran the macro for these examples, there were multiple tables from which results should have been pulled. The final result should have had several paragraphs in the destination cell, but only the next to last table's results appear, albeit the wrong cell's text was copied. If anyone out there can figure out where I'm going wrong with this, I would be so appreciative!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Nested tables. Count rows	NevilleT	Word VBA	9	05-10-2017 05:22 AM
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM
Cells no longer wrap text when changed in nested table	erik2000	Word Tables	1	03-29-2013 03:27 PM
Nested vlookup with varable tables!	Dave Jones	Excel	0	08-30-2012 09:15 AM
Copy table cell formatting across multiple cells / tables	pakistanray	Word Tables	2	10-31-2011 08:07 AM