Microsoft Office Forums - View Single Post - [Solved] Trying to create multiple tables

metalnurse · 12-05-2025, 03:14 PM

Forgive me if this is the wrong place. I'm trying to create a word document from an excel workbook. It needs to generate one page per sheet. There will be some text at the top of each page followed by a table. The issue is that instead of placing a table on each page, it is collapsing all of the tables into one and placing it at the end of the document. I've tried placing paragraphs after the table creation in the loop to no avail. I'm stumped.
The code is as follows:

Code:

Sub Create_Contact_Log2()
Dim wdApp As Word.Application
Set wdApp = New Word.Application
With wdApp
    .Visible = True
    .Activate
    .Documents.Add.PageSetup.Orientation = wdOrientLandscape
End With

Dim ExcludeArray() As Variant
Dim ws As Worksheet
Dim month As String
Dim year As String
Dim tbl As Table
Dim MyRange As Object


month = ActiveWorkbook.Worksheets("SET DATE").Range("C1")
year = ActiveWorkbook.Worksheets("SET DATE").Range("E1")


Dim InTheList As Boolean

ExcludeArray = Array("SET DATE", "Crisis Schedule", "STATS", "ACTT Staff - Contact Numbers", "TCL Housing Status", "Client Address List", "ITT", "KPI", "HOSPITALIZATIONS", "OFFICE DATA ENTRY", "Contact Log", "TOP", "BOTTOM")




For Each ws In ActiveWorkbook.Worksheets
    InTheList = Not (IsError(Application.Match(ws.name, ExcludeArray, 0)))
    
    If Not InTheList Then
        Dim client As String
        client = ws.Range("A35")
        
        With wdApp.Selection
            .Collapse Direction:=wdCollapseEnd
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Font.name = "Calibri"
            .Font.Size = 20
            ' Header
            .TypeText month & " " & year
            
            .TypeParagraph
            .BoldRun
            .ParagraphFormat.Alignment = wdAlignParagraphRight
            .Font.name = "Calibri"
            .Font.Size = 11
            .TypeText "client: "
            .BoldRun
            .TypeText client
            
            .TypeParagraph
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
            .BoldRun
            .TypeText "Case responsible: "
            .BoldRun
            .TypeText ws.Range("A26") & "    "
            
            .BoldRun
            .TypeText "Auth Due: "
            .BoldRun
            .TypeText ws.Range("B30") & "    "
            
            .BoldRun
            .TypeText "APCP Due: "
            .BoldRun
            .TypeText ws.Range("B26") & "    "
            
            .BoldRun
            .TypeText "UD PCP Due: "
            .BoldRun
            .TypeText ws.Range("B28") & "    "
            
            .BoldRun
            .TypeText "ITT Due: "
            .BoldRun
            .TypeText ws.Range("C28")
            
            
            ' Create the table
            .TypeParagraph
            
            Set MyRange = ActiveDocument.Content
            MyRange.Collapse Direction:=wdCollapseEnd
            Set tbl = ActiveDocument.Tables.Add(Range:=MyRange, NumRows:=4, NumColumns:=6)
            
            .TypeParagraph
            .TypeParagraph
            
            tbl.Style = "Table Grid"
            
            With tbl.Rows(1)
                .Cells(1).Range.Text = "Day"
                .Cells(2).Range.Text = "Staff"
                .Cells(3).Range.Text = "Type"
                .Cells(4).Range.Text = "-X +"
                .Cells(5).Range.Text = "Plan"
                .Cells(6).Range.Text = "Actual/Response, Stage of change"
                .Range.Font.Bold = True
                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter
            End With
            
            
            
            .InsertNewPage
        End With
        
    End If
Next

End Sub