VBA/Macros help for an Excel to Word document generator. Need to create and find/replace X tables, where X is the numberof rows TRUE in another sheet

[miknic]

Hi Excel brains trust,

My company have created a Report generator using a spreadsheet + VBA/macros.

To use it, our employees fill in a row, select a template from a dropdown, enter the reference pertaining to it, and then click a "Create Document" button. The code then reads which template is required, creates a new Word doc from said template, and fills in the placeholders based on the row.

The code does the following steps:

1. Check if template selected in Cell C1
2. Check if reference was provided in Cell F1
3. Check the template actually exists within the folder
4. Find the data and where the data starts
5. Opens the correct Word doc and start the find and replace process within the main body of the document
6. It loops through and fine/replaces based on placeholders in row 3
7. Special handler for text boxes
8. End code

We're looking to level this up with some new data we have but aren't sure how to go about it. I will do my best to explain what we are trying to achieve.

We want an additional sheet within the workbook, where we can copy and paste technical data from another programme into. This would be deleted and done fresh with each new document, as does not need to stay there. When the doc is generated, we want it to pull these rows into the doc as a new table per row present. It's easy enough to do it for one table/row but we need it to return multiple tables based on how many rows there are. E.g. one new table per row present. Sometimes this it's 2 - sometimes it's 20.

Something like...
> check 'Sheet 3' for rows excluding the header
> counts how many rows have data
> create the table with the placeholders
> find and replace based on placeholders
> loop until all rows with data have a table

This would likely be in between step 6 and 7 in the code?

I'm really hoping this makes sense! Here's a screenshot of how the sheet is set up.

Thanks in advanced - let me know what else I need to post! Hoping to avoid posting the whole code due to work confidentiality purposes but maybe I can post redacted parts or send them in a message if required.

Regards,

Mik

P.s. our VBA/Macros skills would be considered Intermediate.

 

[NdNoviceHlp]

Hi miknic and Welcome to the Board. I'm not quite clear on your ask. You want to add multiple tables to an already open Word document.... 1 table for each row. 1 row tables? Does each table have "headers" in row 1? Does each table have the same number of columns? U want to add place holders to the table such as a bookmark? Why not just place your data in the separate table cells? Here's some example code that adds a table to the bottom of an open Word doc, places data in the cells, formats the table and then ensures that the table doesn't overlap pages. HTH. Dave

'open existing Word doc
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = False
Set WrdDoc = WrdApp.Documents.Open("D:\testfolder\tabletest.docx")
'***do other stuff here
'add tables to bottom of doc
'loop tables here
Set objSelection = WrdApp.Selection
objSelection.typeparagraph
Set WrdRng = WrdApp.ActiveDocument.Range(Start:=ODoc.Characters.Count - 2, _
                                            End:=ODoc.Characters.Count - 2)
With WrdDoc
.Tables.Add WrdRng, NumRows:=1, NumColumns:=4
.Tables(1).Cell(1, 1).Range = CStr(Sheets("Sheet3").Range("A" & 2))
.Tables(1).Cell(1, 2).Range = CStr(Sheets("Sheet3").Range("B" & 2))
.Tables(1).Cell(1, 3).Range = CStr(Sheets("Sheet3").Range("C" & 2))
'etc.

'format table
With WrdDoc.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
ColWdth = TblWdth / 4 'number of columns
End With
Set WordTbl = .Tables(1)
With WordTbl
.AutoFormat Format:=16, applyborders:=True
.AutoFitBehavior (0)
.Columns.Width = ColWdth
End With
End With

'end table loop here

'prevent tables from splitting page
For Each Otbl In WrdApp.ActiveDocument.Tables
Otbl.Range.Paragraphs.keepwithnext = True
For Each Ocel In Otbl.Rows.last.Range.Cells
Ocel.Range.Paragraphs.last.keepwithnext = False
Next Ocel
Next Otbl

 

[miknic]

Hi miknic and Welcome to the Board. I'm not quite clear on your ask. You want to add multiple tables to an already open Word document.... 1 table for each row. 1 row tables? Does each table have "headers" in row 1? Does each table have the same number of columns? U want to add place holders to the table such as a bookmark? Why not just place your data in the separate table cells? Here's some example code that adds a table to the bottom of an open Word doc, places data in the cells, formats the table and then ensures that the table doesn't overlap pages. HTH. Dave

'open existing Word doc
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = False
Set WrdDoc = WrdApp.Documents.Open("D:\testfolder\tabletest.docx")
'***do other stuff here
'add tables to bottom of doc
'loop tables here
Set objSelection = WrdApp.Selection
objSelection.typeparagraph
Set WrdRng = WrdApp.ActiveDocument.Range(Start:=ODoc.Characters.Count - 2, _
                                            End:=ODoc.Characters.Count - 2)
With WrdDoc
.Tables.Add WrdRng, NumRows:=1, NumColumns:=4
.Tables(1).Cell(1, 1).Range = CStr(Sheets("Sheet3").Range("A" & 2))
.Tables(1).Cell(1, 2).Range = CStr(Sheets("Sheet3").Range("B" & 2))
.Tables(1).Cell(1, 3).Range = CStr(Sheets("Sheet3").Range("C" & 2))
'etc.

'format table
With WrdDoc.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
ColWdth = TblWdth / 4 'number of columns
End With
Set WordTbl = .Tables(1)
With WordTbl
.AutoFormat Format:=16, applyborders:=True
.AutoFitBehavior (0)
.Columns.Width = ColWdth
End With
End With

'end table loop here

'prevent tables from splitting page
For Each Otbl In WrdApp.ActiveDocument.Tables
Otbl.Range.Paragraphs.keepwithnext = True
For Each Ocel In Otbl.Rows.last.Range.Cells
Ocel.Range.Paragraphs.last.keepwithnext = False
Next Ocel
Next Otbl

Hello!!

This is soo helpful. Not quite what we're after (due to my poor explanation) but still helps point us in the right direction.

I've got a couple of new screenshots to try and address some of your questions.

- Screenshot 1 is an example of how the data looks.
- Screenshot 2 shows what we are trying to achieve in the Word doc.

Essentially 1 x 3 column table per Excel row. The headers are in column B. The data is in column C.

At the moment it's copied and pasted/transposed manually, and then formatted afterwards.

There is a specific part of the doc it needs to live (it's legislative type stuff).

Hoping this clarifies my needs a bit!! And thanks again for being so generous with your time.

 

[NdNoviceHlp]

I'm guessing that there is more than 1 ID? If so, are there different amounts of tables for each ID? "There is a specific part of the doc it needs to live" ... what does this mean? Where do U want to put these tables? The code as is, places the table(s) below the current selection of the document. If you want to place them elsewhere, the document must contain the placeholders (eg. bookmark). Maybe a bit more info is needed. Dave
ps. What is image 1 above? Same as initial image?

 

[miknic]

Hi Dave,

We have placeholders for everything else, so that is something that has worked for us previously. The tables need to live in the middle of the doc.

Image 1 is just a wider view of the original image. Yes there is more than 1 ID!

If we just put in a bunch of tables and placeholders, we can do it no problem. But that feels very messy. We would need to delete the unnecessary ones each time.

 

[NdNoviceHlp]

If you insert an unknown number of tables in the middle of a document, the remainder of the document will "move down". Is this OK? Is it tables just for the 1 ID in each document or tables for all existing ID's? How do you indicate where the middle of the document is so as to determine where to place the tables? Dave

 

[NdNoviceHlp]

Whoops. I see by image 1 that each row has an ID number. My misunderstanding. So you want each ID number to be used for each separate table? Dave

 

[miknic]

Whoops. I see by image 1 that each row has an ID number. My misunderstanding. So you want each ID number to be used for each separate table? Dave

Hi Dave - yes correct. Each ID number has a separate table.

Not a problem with the document moving down. Ideally we would have one placeholder in the middle of the document, and all tables will go into that location.

 

[NdNoviceHlp]

Hi again miknic. I thought that maybe you had moved on. You will need to place a bookmark named "TableRngBookmark" in the document where you want the tables placed. You will also have to adjust the file path in the code to your needs. You can probably run this code after your done everything else (ie. after your other data placement code) but it would make more sense to amend this code to combine it with your existing code being that your document is already open. Anyways, my limited testing seemed to indicate this will work. Dave

 Sub testtable()
'insert table(s) at bookmark "TableRngBookmark"
Dim WrdApp As Object, RowCnt As Integer, TblCnt As Integer, TblWdth As Double
Dim WrdDoc As Object, TblCell As Variant, WrdRng As Variant, ColWdth As Double
Dim Lastrow As Integer, BMSelection As Object, WordTbl As Object
Dim Otbl As Object, Ocel As Object
'last data row
With Sheets("Sheet3")
Lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
End With

On Error GoTo ErFix
'open existing Word doc
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = False
'*********** change file address to suit
Set WrdDoc = WrdApp.Documents.Open("D:\testfolder\tabletest.docx")

'find bookmark
With WrdDoc
If .Bookmarks.Exists("TableRngBookmark") Then
Set BMSelection = .Bookmarks("TableRngBookmark").Range
Else
MsgBox "No Bookmark!"
GoTo ErFix
End If
End With

'put tables at bookmark
For RowCnt = 2 To Lastrow
TblCnt = TblCnt + 1
With WrdDoc
.Tables.Add BMSelection.Characters.Last, NumRows:=3, NumColumns:=3
.Tables(TblCnt).Cell(1, 1).Range = CStr(Sheets("Sheet3").Range("A" & RowCnt))
.Tables(TblCnt).Cell(1, 2).Range = "Details:"
.Tables(TblCnt).Cell(1, 3).Range = CStr(Sheets("Sheet3").Range("B" & RowCnt))
.Tables(TblCnt).Cell(2, 2).Range = "Address:"
.Tables(TblCnt).Cell(2, 3).Range = CStr(Sheets("Sheet3").Range("C" & RowCnt))
.Tables(TblCnt).Cell(3, 2).Range = "Day Worked:"
.Tables(TblCnt).Cell(3, 3).Range = CStr(Sheets("Sheet3").Range("D" & RowCnt))

'format table
With WrdDoc.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
ColWdth = TblWdth / 3 'number of columns
End With
Set WordTbl = .Tables(TblCnt)
With WordTbl
.AutoFormat Format:=16, applyborders:=True
.AutoFitBehavior (0)
.Columns.Width = ColWdth
End With

'provide for multiple tables
With BMSelection
.End = WordTbl.Range.End
.Characters.Last.Next.InsertBefore vbCr & vbCr
.End = .End + 2
End With
.Bookmarks.Add "TableRngBookmark", BMSelection

End With 'WrdDoc
Next RowCnt

'prevent tables from splitting page
For Each Otbl In WrdApp.ActiveDocument.Tables
Otbl.Range.Paragraphs.keepwithnext = True
For Each Ocel In Otbl.Rows.Last.Range.Cells
Ocel.Range.Paragraphs.Last.keepwithnext = False
Next Ocel
Next Otbl

'close, save, quit Word and clean up
WrdApp.ActiveDocument.Close savechanges:=True
Set WrdDoc = Nothing
WrdApp.Quit
Set WrdApp = Nothing
MsgBox "Finished"
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "error"
Set WrdDoc = Nothing
WrdApp.Quit
Set WrdApp = Nothing
End Sub

 

[miknic]

Hi again miknic. I thought that maybe you had moved on. You will need to place a bookmark named "TableRngBookmark" in the document where you want the tables placed. You will also have to adjust the file path in the code to your needs. You can probably run this code after your done everything else (ie. after your other data placement code) but it would make more sense to amend this code to combine it with your existing code being that your document is already open. Anyways, my limited testing seemed to indicate this will work. Dave

 Sub testtable()
'insert table(s) at bookmark "TableRngBookmark"
Dim WrdApp As Object, RowCnt As Integer, TblCnt As Integer, TblWdth As Double
Dim WrdDoc As Object, TblCell As Variant, WrdRng As Variant, ColWdth As Double
Dim Lastrow As Integer, BMSelection As Object, WordTbl As Object
Dim Otbl As Object, Ocel As Object
'last data row
With Sheets("Sheet3")
Lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
End With

On Error GoTo ErFix
'open existing Word doc
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = False
'*********** change file address to suit
Set WrdDoc = WrdApp.Documents.Open("D:\testfolder\tabletest.docx")

'find bookmark
With WrdDoc
If .Bookmarks.Exists("TableRngBookmark") Then
Set BMSelection = .Bookmarks("TableRngBookmark").Range
Else
MsgBox "No Bookmark!"
GoTo ErFix
End If
End With

'put tables at bookmark
For RowCnt = 2 To Lastrow
TblCnt = TblCnt + 1
With WrdDoc
.Tables.Add BMSelection.Characters.Last, NumRows:=3, NumColumns:=3
.Tables(TblCnt).Cell(1, 1).Range = CStr(Sheets("Sheet3").Range("A" & RowCnt))
.Tables(TblCnt).Cell(1, 2).Range = "Details:"
.Tables(TblCnt).Cell(1, 3).Range = CStr(Sheets("Sheet3").Range("B" & RowCnt))
.Tables(TblCnt).Cell(2, 2).Range = "Address:"
.Tables(TblCnt).Cell(2, 3).Range = CStr(Sheets("Sheet3").Range("C" & RowCnt))
.Tables(TblCnt).Cell(3, 2).Range = "Day Worked:"
.Tables(TblCnt).Cell(3, 3).Range = CStr(Sheets("Sheet3").Range("D" & RowCnt))

'format table
With WrdDoc.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
ColWdth = TblWdth / 3 'number of columns
End With
Set WordTbl = .Tables(TblCnt)
With WordTbl
.AutoFormat Format:=16, applyborders:=True
.AutoFitBehavior (0)
.Columns.Width = ColWdth
End With

'provide for multiple tables
With BMSelection
.End = WordTbl.Range.End
.Characters.Last.Next.InsertBefore vbCr & vbCr
.End = .End + 2
End With
.Bookmarks.Add "TableRngBookmark", BMSelection

End With 'WrdDoc
Next RowCnt

'prevent tables from splitting page
For Each Otbl In WrdApp.ActiveDocument.Tables
Otbl.Range.Paragraphs.keepwithnext = True
For Each Ocel In Otbl.Rows.Last.Range.Cells
Ocel.Range.Paragraphs.Last.keepwithnext = False
Next Ocel
Next Otbl

'close, save, quit Word and clean up
WrdApp.ActiveDocument.Close savechanges:=True
Set WrdDoc = Nothing
WrdApp.Quit
Set WrdApp = Nothing
MsgBox "Finished"
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "error"
Set WrdDoc = Nothing
WrdApp.Quit
Set WrdApp = Nothing
End Sub

Dave - you're an absolute legend.

Will play with this and see how we go! Is there a "buy a beer" feature here?