From excel to specific cells in a table in word - excel

Question

I've seen some questions answered about creating tables in word from excel but they don't quite have what I'm looking for. I have an excel sheet that has the details on equipment (company #, serial #, manufacturer, description, and model #). This file currently has 17114 rows of equipment data. I have a word doc with four columns (quantity, company #, part #, description).
Right now on excel I have a button to open up the word doc and another that brings up a userform. The user form has a combo box and a text bot. The combo box chooses what column in excel to search in. The text box is what the person is looking for. The code for this is below
Dim myLastRow As Long
Dim myResult As Long
Dim myTableRange As Range
myLastRow = Cells(Rows.Count, 1).End(xlUp).Row
If ComboBox1.Value = "Serial" Then
Set myTableRange = Range("B1:B" & myLastRow)
myResult = Application.Match(TextBox1.Value, myTableRange, 0) 'Returns row number only
Range("B" & myVLookupResult).Activate
ElseIf ComboBox1.Value = "MII" Then
Set myTableRange = Range("A1:A" & myLastRow)
myResult = Application.Match(TextBox1.Value, myTableRange, 0) 'Returns row number only
Range("A" & myResult).Activate
Else
MsgBox ("No Range Selected")
End If
Where "MII" is the company #. This code is placed on a command button. From here I want the macro to copy the data from myResult over to word. The cells to copy would be
Cells(myResult, 1)
to the second column in word;
Cells (myResult, 2)
to the third column in word; and
Cells(myResult, 3) & ", " & Cells(myResult, 4) & ", Model #" & Cells(myResult, 5)
to the 4th column in word. I am also looking for word to check where the first blank row is (after the headers) and insert these there. And if there are no blank rows before the footer (also part of the table) to add a row.
The default number of rows I can put the data is 16. With 13 rows for the header (header is part of the table). A total of 19 rows will create a second page but without any cells on the second page for data (only the header and footer). It isn't until 28 rows are made that cells for data start popping up on page 2.
My questions are how do I reference specific cells in a table in word? Can I use the same code for finding the first blank cell after the header as I would in excel? Would the code also be the same for adding rows to the table and counting the available rows to make sure I'm typing on the right page?
Right now all I have for the word side of the macro is calling the document up.
Dim objWord, objDoc As Object
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
I know I can use something similar as below but that doesn't specify where to put the data.
Sheets(1).Range(FirstCell, LastCell).Copy
objWord.Selection.Paste
objWord.Selection.TypeParagraph

Answer 1

I still haven't figured out how to add rows automatically. I keep getting run-time error '5991': Cannot access individual rows in this collection because the table has vertically merged cells. (Edit: I found out I didn't have the Microsoft Word Object Library reference clicked. After doing this other answers to this question worked.)
Since what I have done is still a decent time saver for me and might help other people trying to do the same thing I'm going to post what I have so far. Note: there's still some unused code in there from trying out stuff to see if it worked or not.
Dim myLastRow As Long
Dim myResult As Long
Dim myTableRange As Range
myLastRow = Cells(Rows.Count, 1).End(xlUp).Row
If ComboBox1.Value = "Serial" Then
Set myTableRange = Range("B1:B" & myLastRow)
myResult = Application.Match(TextBox1.Value, myTableRange, 0) 'Returns row number only
ElseIf ComboBox1.Value = "MII" Then
Set myTableRange = Range("A1:A" & myLastRow)
myResult = Application.Match(TextBox1.Value, myTableRange, 0) 'Returns row number only
Else
MsgBox ("No Range Selected")
End If
Dim objWord, objDoc As Object
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
Dim tableRow As Long
Dim rowCount As Long
Dim lastTableCell As Long
Dim i As Long
Dim cellEmpty As Boolean
'lastTableCell = 28 'Defualt input range is from cell 13 to 28
lastTableCell = 100
cellEmpty = True
findEmptyCell:
For i = 13 To lastTableCell
If objWord.ActiveDocument.Tables(1).Cell(i, Column:=1).Range.Text = Chr(13) & Chr(7) Then
tableRow = i
cellEmpty = True
GoTo rowFound
End If
allCellsFilled:
If cellEmpty = False Then
objWord.ActiveDocument.Tables.Item(1).Rows(i - 1).Select
Selection.InsertRowsBelow (i - 1)
cellEmpty = True
GoTo findEmptyCell
End If
Next i
rowFound:
On Error GoTo errorHappened
objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=1).Range.Text = "1"
objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=2).Range.Text = Cells(myResult, 1).Value
objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=3).Range.Text = Cells(myResult, 2).Value
objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=4).Range.Text = Cells(myResult, 3).Value & ", " & Cells(myResult, 4).Value & ", Model # " & Cells(myResult, 5).Value
GoTo endTheSub
errorHappened:
cellEmpty = False
GoTo allCellsFilled
endTheSub:
End Sub