From excel to specific cells in a table in word

user_10582471 0
Viewed 129

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
vba excel
1 Answers

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
user_105824710
Related