Prevent Vertically Merged Cells from Breaking Across Page - Automatically - vba

Question

I have to create documents that have large tables of data copied into them from Excel. The tables can be hundreds of rows long and generally ~20 columns wide. Many of the columns have been merged vertically to enhance readability and group sets of data.
I have been able to write a macro that will fully format the entire table, except I have not been able to figure out how to automatically prevent the Vertically Merged cells from breaking/splitting across multiple pages. To do it manually, you select all of the rows in the merger except for the last one and then you turn on "Keep With Next" in the paragraph settings. I thought this would be easy to do, but you can not access individual rows in VBA if there are any vertically merged cells in the table.
Does anyone have an idea how to automatically go through the rows and set the "Keep With Next" property for groups of rows that have been merged together?
Here is an example of how Word normally handles vertically merged cells across tables:
This is how I would like it to look, with doing all the work manually:

Answer 1

Yes, working with merged cells in Word (and Excel for that matter) is quite annoying.
This can be done, though, by accessing individual cells in table. I have written the following Sub Routine below that should work for you. I assumed that you had at least one column with no vertically merged cells in it and that you only had one column that controlled the length of the merged block. Although adding more controlling columns should be easy.
Sub MergedWithNext() 'FTable As Table)
Dim Tester As String
Dim FTable As Table
Dim i As Integer
Dim imax As Integer
Dim RowStart As Integer
Dim RowEnd As Integer
Dim CNMerged As Integer
Dim CNNotMerged As Integer
Dim CNMax As Integer
CNMerged = 2 'A column number that is vertically merged that you don't want to split pages
CNNotMerged = 1 'A column number that has no vertical mergers
Set FTable = Selection.Tables(1)
With FTable
imax = .Rows.Count
CNMax = .Columns.Count
'Start with no rows kept with next
ActiveDocument.Range(Start:=.Cell(1, 1).Range.Start, _
End:=.Cell(imax, CNMax).Range.End).ParagraphFormat.KeepWithNext = False
On Error Resume Next
For i = 2 To imax 'Assume table has header
Tester = .Cell(i, CNMerged).Range.Text 'Test to see if cell exists
If Err.Number = 0 Then 'Only the first row in the merged cell will exist, others will not
'If you are back in this If statement, then you have left the previous block of rows
'even if that was a block of one. The next If statement checks to see if the previous
'row block had more than one row. If so it applies the "KeepWithNext" property
If (RowEnd = (i - 1)) Then
'.Cell(RowStart, 1).Range.ParagraphFormat.KeepWithNext = True
ActiveDocument.Range(Start:=.Cell(RowStart, CNNotMerged).Range.Start, _
End:=.Cell(RowEnd - 1, CNNotMerged).Range.End).ParagraphFormat.KeepWithNext = True
'Use RowEnd - 1 because you don't care if the whole merged block stays with the next
'row that is not part of the merger block
End If
RowStart = i 'Beginning of a possible merger block
RowEnd = 0 'Reset to 0, not really needed, used for clarity
Else
RowEnd = i 'This variable will be used to determine the last merged row
Err.Clear
End If
If i = imax Then 'Last Row
If (RowStart <> imax) Then
ActiveDocument.Range(Start:=.Cell(RowStart, CNNotMerged).Range.Start, _
End:=.Cell(imax - 1, CNNotMerged).Range.End).ParagraphFormat.KeepWithNext = True
'Use imax - 1 because you don't care if the whole merged block stays with the next
'row that is not part of the merger block
End If
End If
Next i
On Error GoTo 0
End With
End Sub
This code will loop through each row in the table, excluding the header, looking for vertically merged cells. Once it finds a block, it will assign the "Keep With Next" property to each row in the block, except for the last row.