Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 03-09-2019, 08:20 PM
jrooney7 jrooney7 is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Sep 2018
Posts: 13
jrooney7 is on a distinguished road
Default How to compile text from multiple tables into a cell in a nested table

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!
Attached Images
File Type: png Example Table.png (16.5 KB, 5 views)
File Type: png Results Table.png (8.7 KB, 5 views)
File Type: png Results Table after macro.png (9.6 KB, 5 views)
File Type: png Results Table correct.png (10.2 KB, 5 views)
Reply With Quote
  #2  
Old 03-10-2019, 01:02 PM
jrooney7 jrooney7 is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Sep 2018
Posts: 13
jrooney7 is on a distinguished road
Default

While I was playing with this today, I noticed that which cell it copies in the other tables has do with where the cursor is to begin with. If the cursor is already in the destination cell, it's copying Cell(3, 1) for some reason, but if I put the cursor in the longest table in the document, it seems to be copying the last row correctly. I'm thinking it's a problem with my NumberOfRowsInCurrentTable setup. Ideally, the code should work regardless of which table the cursor is in - I don't want the end-user having to figure out which is the longest table.

Also, the code is pasting the results contents over previous entries. The sample document has 8 "Worksheet" tables from which the results should be pulled, but only the last "Worksheet" table's results are appearing in the destination cell, so it seems that the results from each "Worksheet" table are being pasted over by the next result - regardless of the length of the result.

I hope this gives some insights. I slightly altered my original code in an attempt to solve my problem, the newer code is below. I am attaching my document if that would help figure out what's going on. The macro is called "Results" and I added a button to the Quick Access Toolbar for the end-user - you can see its location in the attached png.

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.Range.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.EndKey Unit:=wdLine
                Selection.Paste
                ' this section is for when the destination cell in the Results Table already contains text
                ElseIf Len(ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Text) > 3 Then
                ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Select
                Selection.EndKey Unit:=wdLine
                Selection.TypeParagraph
                Selection.TypeParagraph
                Selection.Paste
            End If
        End If
    Next
    
End Sub
Attached Images
File Type: png Results compiler macro button.png (27.0 KB, 3 views)
Attached Files
File Type: dotm Firearms Unit Worksheet (for upload).dotm (398.2 KB, 0 views)

Last edited by jrooney7; 03-10-2019 at 01:10 PM. Reason: Uploaded cleaned up version of word dotm and updated code
Reply With Quote
  #3  
Old 03-11-2019, 07:55 AM
jrooney7 jrooney7 is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Sep 2018
Posts: 13
jrooney7 is on a distinguished road
Default

Hello again, I was able to solve the issue of the contents pasting over each other. I changed the
Code:
Selection.Paste
to
Code:
Selection.PasteSpecial DataType:=wdPasteText
Now, all the results are appearing correctly, but you still have to put the cursor in the longest table. If anyone could figure that one out, great!!!
Reply With Quote
Reply

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 04:01 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft