Generating Reports in Word Using Data in Excel

[davidd30528]

Hi everyone,

I hope you are doing well and are getting ready for the weekend.

I'm new to VBA and looking to automate the report generation process where for each of the value in criteria range, the macro will paste the value in a filter cell and based on that criterion, excel formulas will populate information in various tables. After that, the macro will open a template document and copy those tables and paste them as pictures into a designated place within the template. After that, the macro will save the final report in a specified location.

Below is how I was envisioning the process will look like:
- For each cell in criteria range (column H of the Filter tab of the excel. Screenshots of Excel files are attached), macro will copy the hotel name and paste it into the filter cell (cell B3) of the filter tab.
- Then macro will open the report template (sample of the template is attached), which is saved in a specified location on a local computer (location of the template is specified in cell A8 of the filter tab of the excel file)
- Then macro will copy populate the hotel name (cell B3 of the filter tab) and paste it in the template where it is bookmarked as "Placeholder for Hotel Name", and it does the same for the location (cell B4 of table 1 tab into the word document where it is bookmarked as "Placeholder for Business Location")
- Then for each Table 1-3 tabs, macro will determine the table size (size of table 2-3 varies as it depends on how long is the list within the table; where as size of table 1 is fixed. For example, for "Six Senses Phuket", table 2 will be 4 rows long; whereas for Kimpton Chicago, table 2 will be 6 rows long). Then macro copy the tables and paste it as picture in a designated location that is bookmarked as Placeholder for Table X. Though for Table 2-3 tabs, macro will also check if cell A7 is blank and if so, macro will copy range A1:C2 and paste it into the template as picture.
- Then macro save as the word document in a defined location (location is specified in cell A12 of filter tab of the excel file). The file name will follow a specific format: Hotel Report - [Hotel Name]

I wrote the below code in Excel but it seems to keep breaking and I'm not sure what I'm missing... I would really appreciate if you could help me take a look and help me debug it.

Sub Report_Generation()

Dim TemplatePath As String
Dim SaveLocation As String
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim lastrow As Long
Dim hotelname As String

TemplatePath = Worksheets("Filter").Range("A8")
SaveLocation = Worksheets("Filter").Range("A12")

Set WrdApp = CreateObject("Word.Application")
Set WrdDoc = WrdApp.Documents.Open(TemplatePath)
WrdApp.Run
WrdApp.Visible = True

For Each Hotel_Name In Worksheets("Filter").Range("H2:H4")
    Hotel_Name.Copy
    Range("B3").PasteSpecial Paste:=xlPasteValues
    
    Sheets("Table 1").Range("B2").Copy
    WrdDoc.Bookmarks("HotelName").Select
    WrdApp.Selection.Paste
    .TextRange.Fields.Update
    
    Sheets("Table 1").Range("B4").Copy
    WrdDoc.Bookmarks("Location").Select
    WrdApp.Selection.Paste
    .TextRange.Fields.Update
    
    Sheets("Table 1").Range("A1:B4").Copy
    WrdDoc.Bookmarks("Table1").Select
    WrdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
    
    If Sheets("Table 2").Range("A7").Value = "" Then
        Sheets("Table 2").Range("A1:C2").Copy
        WrdDoc.Bookmarks("Table2").Select
        WrdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
    Else
        Sheets("Table 2").Range("A5:B17").WrapText = True
        Dim lastrow_table2 As Long
        lastrow_table2 = Sheets("Table 2").Columns("A").Find("*", searchdirection:=xlPrevious, searchorder:=xlByRows, LookIn:=xlValues).Row
        Worksheets("Table 2").Range("A5:C" & lastrow_table2).Copy
        WrdDoc.Bookmarks("Table2").Select
        WrdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
    End If
    
    If Sheets("Table 3").Range("A7").Value = "" Then
        Sheets("Table 3").Range("A1:C2").Copy
        WrdDoc.Bookmarks("Table2").Select
        WrdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
    Else
        Sheets("Table 5").Range("A5:C20").WrapText = True
        Dim lastrow_table2 As Long
        lastrow_table3 = Sheets("Table 3").Columns("A").Find("*", searchdirection:=xlPrevious, searchorder:=xlByRows, LookIn:=xlValues).Row
        Worksheets("Table 3").Range("A5:C" & lastrow_table3).Copy
        WrdDoc.Bookmarks("Table3").Select
        WrdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
    End If
    
    hotelname = Worksheets("Filter").Range("B3")
    WrdDoc.SaveAs Filename:=SaveLocation & hotelname, FileFormat:=wdFormatDocumentDefault
    WordDoc.Close
    wordApp.Quit
    Set WordDoc = Nothing
    Set wordApp = Nothing
    
Next
            
End Sub

Thank you in advance for your kind help.

Cheers,
David

 

[Dan_W]

Hi - I just stumbled across your post now. Do you still need help with this?