Hello all,
I have a word document (*.dotm) that will have a random number of tables, some of which will have a first row containing the word "Worksheet" - e.g. "Firearm Worksheet", "Bullet Worksheet", etc. The code below is intended to loop through the tables in the document and if it finds one with the word "Worksheet" in the first row, it copies the text in the last row and pastes it to a destination cell in the last table of the document. However, the code as written copies based where the cursor is to begin with. If the cursor is in a table that is not the longest (there is some other table that contains more rows), the code is pulling text based on the length of that table, so it's not the last row. 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, or even if the cursor is not in a table - I don't want the end-user having to figure out which is the longest table. Here is my code:
Code:
Sub Results()
'
' Results Macro
'
'
Application.ScreenUpdating = False
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.PasteSpecial DataType:=wdPasteText
' 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.PasteSpecial DataType:=wdPasteText
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Any help is appreciated!