How do I generate a formatted Word report from multi-row/column Excel spreadsheet

Question

I'm trying to auto-build a formatted Word report from an Excel template used by multiple teams. For example, if i have the following Excel structure:

......A.... |.....B.... |....C...
1 Name | Height | Weight
2 Jason | 74 | 170
3 Greg | 70 | 160
4 Sam | 71 | 200

and I want to pull out that data and format into a Word file with the following format:

2.1 Jason
Height: 74
Weigh: 170

2.2 Greg
Height: 70
Weight: 160

2.3 Sam
Height: 71
Weight: 200

Is there a quick way to do that with VBA and be able to iterate through as many rows as may exist in any particular Excel file? (could vary from a few to many hundreds) The real excel file contains about a dozen columns where for each record (row) the data needs to be pulled out and formatted using standard template (font size/color, indent, alignment, etc...) but i'd love to just get the extract to work and I can play with the formatting later.

For reference, I've tried to research known solutions, but most are centered on named bookmarks and relatively static content vs. interating through a dynamic number of rows and parsing the same data for each.

Answer 1

In case you do end up using VBA, you can use the below code starting from a word document. Make sure to have the Reference for Microsoft Excel X.X Object Library checked in under Tools > References in the VBE.

Just so you know, the part where it puts the strings into Word could probably be written better. Word is my weakest of all MS Office products in terms of knowledge.

Sub XLtoWord()

Dim xlApp As Excel.Application
'Set xlApp = CreateObject("Excel.Application")
Set xlApp = GetObject(, "Excel.Application") '-> assumes XL is open, if not use CreateObject

Dim wkb As Excel.Workbook
Set wkb = xlApp.Workbooks("Book5.xlsm") '-> assumes xl is open, if not use .Workbooks.Open(filename)

Dim wks As Excel.Worksheet
Set wks = wkb.Sheets(1) '-> assumes data is in sheet 1

With wks

    Dim lngRow As Long
    lngRow = .Range("A" & .Rows.Count).End(xlUp).Row

    Dim cel As Excel.Range
    Dim i As Integer

    i = 1

    For Each cel In .Range("A2:A" & lngRow) 'assumes data is filled from top left cell of A1 including headers

        strLabel = "2." & i & " " & cel.Text
        strHeight = "Height " & cel.Offset(, 1).Text
        strWeight = "Weight " & cel.Offset(, 2).Text

        Dim myDoc As Word.Document
        Set myDoc = ThisDocument

        myDoc.Range.InsertParagraphAfter
        myDoc.Range.InsertAfter strLabel & Chr(11) & strHeight & Chr(11) & strWeight

        i = i + 1

    Next

End With


End Sub