Trying to create multiple tables

metalnurse · #1 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

macropod · #2 12-05-2025, 11:23 PM

Cross-posted at: Can't create tables automatically in Word document from Excel VBA - Stack Overflow
For cross-posting etiquette, please read: A Message to Forum Cross Posters - Excelguru

macropod · #3 Yesterday, 01:02 AM

Your approach is quite inefficient. You would do far better to use a template with the required configuration and avoid using selections. The code could then be reduced to:

Code:

Sub Create_Contact_Log()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Set wdDoc = Documents.Add(Template:=ActiveWorkbook.Path & "\Contact_Log.dotx")
Dim ws As Worksheet, i As Long: i = 0
Dim month As String: month = ActiveWorkbook.Worksheets("SET DATE").Range("C1")
Dim year As String: year = ActiveWorkbook.Worksheets("SET DATE").Range("E1")

For Each ws In ActiveWorkbook.Worksheets
    Select Case ws.Name
      Case "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"
      Case Else
        i = i + 1
        With wdDoc
          If i > 1 Then
            .Range.Sections.Add Range:=.Range.Characters.Last, Start:=wdSectionNewPage
            .Range.Characters.Last.FormattedText = .AttachedTemplate.Range.FormattedText
          End If
          With .Sections.Last.Range
            .Paragraphs(1).Range.InsertBefore month & " " & year
            .Paragraphs(2).Range.Characters.Last.InsertBefore ws.Range("A35")
            With .Tables(1).Range
              .Cells(2).Range.Text = ws.Range("A26")
              .Cells(4).Range.Text = ws.Range("B30")
              .Cells(6).Range.Text = ws.Range("B26")
              .Cells(8).Range.Text = ws.Range("B28")
              .Cells(10).Range.Text = ws.Range("C28")
            End With
          End With
        End With
    End Select
Next
wdApp.Visible = True
End Sub

where Contact_Log.dotx is the template name and it's stored in the same folder as your workbook. A possible template is attached.

metalnurse · #4 Yesterday, 02:13 PM

I found a solution that works for me in the other forum. Your code is very elegant. I'm going to keep a copy and learn from it. Thank you.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Create Table for Multiple Pictures. 1 picture, 1 table and space between tables	gorkac	Word VBA	9	03-11-2022 05:12 AM
dropdown list to create tables	brichigo	Word VBA	8	09-04-2018 02:36 AM
Create multiple copies of same email in multiple folders	gaker10	Outlook	0	10-06-2014 07:44 AM
Macro to create tables around all images in document	lsmcal1984	Word VBA	4	12-01-2013 06:58 PM
Help with using tables to create text.	mh11	Word Tables	0	11-15-2009 10:40 AM