Excel MailMerge to School Report in Word

[LiamD]

Hi,

I want to be able to generate a school report of children who are not performing as expected (evaluate as a 3). Attached is dummy set of data, the number of evaluations (columns) will be far greater - perhaps up to 100.

The original table has a row for each child with the scored evaluation for each topic. The topic description is in Row 2.

Test Number	1	2	3	4
Evaluation	Reads Whole numbers up to 1,000,000	Add two number up to 1,000,000	Reads decimal number, and orders a list from smallest to largest	Multply whole numbers by 10, 100, 1000
Aaron	3	1	2	2
Brenda	2	2	2	2
Charlie	3	1	3	3
Davina	2	2	2	2
Ethan	2	3	1	2
Felicity	2	2	2	2

From this I would like to create a Word document containing only those results that are a 3. The report has the child name, the test number (B1-E1), the description of the test evaluation (B2-E2), and the grade "3" . Only evaluations with a "3" are to be included, all other results are to be filtered out.

Aaron


Taken from CELL B1-E1
Taken from CELL B2-E2
Filter value with a 3 in the Table
Test Score 1
Reads Whole numbers up to 1,000,000
3


Charlie


Taken from CELL B1-E1
Taken from CELL B2-E2
Filter value with a 3 in the Table
Test Score 1
Reads Whole numbers up to 1,000,000
3
Test Score 3
Reads decimal number, and orders a list from smallest to largest
3
Test Score 4
Multply whole numbers by 10, 100, 1000
3


Ethan


Taken from CELL B1-E1
Taken from CELL B2-E2
Filter value with a 3 in the Table
Test Score 2
Add two number up to 1,000,000
3

My approach has been to use MailMerge to create the Word documents.

Some of my current challenges are:
1) Filtering the report for only values of 3. The output is to be compressed without extra newlines.
2) Adding the Evaluation Criteria (B2-E2), into the report.
3) Adding the Test umber (B1-E1), into the report.

If anyone has experience in Excel to Mailmerge with extra formatting and filtering, please let me know if this can be solved.

I would be happy to receive any guidance on any other approach that might be more efficient.

Files:-
SchoolReportDESIREDOutput-MrExcel.docx

SchoolReportMailMerge-MrExcel.docx

SchoolGrading-MrExcel.xlsx

Thanks and Best Wishes,
LiamD

 

[NdNoviceHlp]

Hi LiamD. Just curious, when document space is limited and you're only outputting the results that have a 3, why do you need to include the value in the Word report? It's fairly easy to create a Word document and tables from XL, use a bit of VBA to loop your XL table and output the results to your Word table... not sure if mail merge is any easier? Dave

 

[NdNoviceHlp]

You can trial this code. It doesn't include your 3rd column but can be adjusted if you really believe it's useful. You will need to adjust your file path to suit. Note that the code can either use an existing doc or create a new doc. It's currently set to use an existing doc but the lines of code for creating and then saving a new doc are included (ie. comment out the 2 relevant lines of code and un-comment the other 2 lines of code). HTH. Dave

Sub testtable()
Dim WrdApp As Object, RowCnt As Integer, ColCnt As Integer, TblCnt As Integer, TblRow As Integer
Dim WrdDoc As Object, TblWdth As Double, Lastrow As Integer, WordTbl As Object
Dim Otbl As Object, Ocel As Object

'create Word app
On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WrdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WrdApp.Visible = False

'*********** change file address to suit
Set WrdDoc = WrdApp.Documents.Open("C:\testfolder\testdoc.docx")
'Set WrdDoc = WrdApp.Documents.Add

'get page size for table column width
With WrdDoc.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
End With
'get last row of XL data
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

'loop XL rows
For RowCnt = 3 To Lastrow
TblCnt = TblCnt + 1
With WrdDoc
'add name to doc above table
.Content.InsertAfter Sheets("Sheet1").Cells(RowCnt, 1) & vbCrLf
'add table
.Tables.Add .Range.Characters.Last, NumRows:=1, NumColumns:=2
Set WordTbl = .Tables(TblCnt)
'add table header row 1
.Tables(TblCnt).Cell(1, 1).Range = "Taken from CELL B1-E1"
.Tables(TblCnt).Cell(1, 2).Range = "Taken from CELL B2-E2"
TblRow = 1
'loop XL columns and find "3"
For ColCnt = 2 To 5
If Sheets("Sheet1").Cells(RowCnt, ColCnt) = 3 Then
'add evalution result to table
WordTbl.Rows.Add
TblRow = TblRow + 1
.Tables(TblCnt).Cell(TblRow, 1).Range = "Test Score " & Sheets("Sheet1").Cells(1, ColCnt)
.Tables(TblCnt).Cell(TblRow, 2).Range = Sheets("Sheet1").Cells(2, ColCnt)
End If
Next ColCnt

'format table
With WordTbl
.AutoFormat Format:=16, applyborders:=True
.AutoFitBehavior (0)
'*****adjust column width to suit
.Columns(1).Width = 0.3 * TblWdth
.Columns(2).Width = 0.7 * TblWdth
End With
.Range.InsertAfter Chr(13) 'vbCr
End With
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
'WrdApp.activedocument.SaveAs ("C:\testfolder\testdoc.docx") 'change path to suit
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

 

[LiamD]

Hi Dave,

Many thanks for your response. This was the basic code that I needed to push me in the right direction.

I have stated to modify your code it so that each student will have their own Word document with the tables with "3"s. The file will be saved with the student's name.

I think you are correct, I probably do not need to use mail merge. My thought was that the teacher (who is not familiar with Excel, or macros), would own that Word document. They would be able to put in boilerplate text into the Word document for any report they want to generate. They might want text before and after the "table of 3s", so thought Mail Merge would have been the best way to achieve this.

Again, many thanks for taking the time to reply to this question. I appreciate it!

Best Wishes,
Liam

 

[NdNoviceHlp]

Hi again Liem. I didn't understand re. individual student reports. This will generate individual reports with a student file name. Dave

Sub testtable2()
Dim WrdApp As Object, RowCnt As Integer, ColCnt As Integer, TblCnt As Integer, TblRow As Integer
Dim WrdDoc As Object, TblWdth As Double, Lastrow As Integer, WordTbl As Object
Dim Otbl As Object, Ocel As Object

'create Word app
On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WrdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WrdApp.Visible = False

'get last row of XL data
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

'loop XL rows
For RowCnt = 3 To Lastrow
'TblCnt = TblCnt + 1
TblCnt = 1
Set WrdDoc = WrdApp.Documents.Add
With WrdDoc
'add name to doc above table
.Content.InsertAfter Sheets("Sheet1").Cells(RowCnt, 1) & vbCrLf
'add table
.Tables.Add .Range.Characters.Last, NumRows:=1, NumColumns:=2
Set WordTbl = .Tables(TblCnt)
'add table header row 1
.Tables(TblCnt).Cell(1, 1).Range = "Taken from CELL B1-E1"
.Tables(TblCnt).Cell(1, 2).Range = "Taken from CELL B2-E2"
TblRow = 1
'loop XL columns and find "3"
For ColCnt = 2 To 5
If Sheets("Sheet1").Cells(RowCnt, ColCnt) = 3 Then
'add evalution result to table
WordTbl.Rows.Add
TblRow = TblRow + 1
.Tables(TblCnt).Cell(TblRow, 1).Range = "Test Score " & Sheets("Sheet1").Cells(1, ColCnt)
.Tables(TblCnt).Cell(TblRow, 2).Range = Sheets("Sheet1").Cells(2, ColCnt)
End If
Next ColCnt

'get page size for table column width
With WrdDoc.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
End With

'format table
With WordTbl
.AutoFormat Format:=16, applyborders:=True
.AutoFitBehavior (0)
'*****adjust column width to suit
.Columns(1).Width = 0.3 * TblWdth
.Columns(2).Width = 0.7 * TblWdth
End With
End With

WrdApp.activedocument.SaveAs ("C:\testfolder\" & Sheets("Sheet1").Cells(RowCnt, 1) & ".docx") 'change path to suit
Next RowCnt

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