Andrew\T-Belle
Changing the view to Normal and combining a couple of processes will come even closer. There is still a problem is the last row has VMCs and that could be due to the Err_Handler to get passed the earlier error presented.
Code:
Sub ProcTbls()
Dim oTbl As Table, oNT As Table
Dim lngView As Long
lngView = ActiveDocument.ActiveWindow.View
ActiveDocument.ActiveWindow.View = wdNormalView
Application.ScreenUpdating = False
For Each oTbl In ActiveDocument.Tables
SplitVMCs oTbl
MarkNonUniformity oTbl
For Each oNT In oTbl.Tables
SplitVMCs oNT
MarkNonUniformity oNT
Next oNT
Next oTbl
ActiveDocument.ActiveWindow.View = lngView
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
Sub SplitVMCs(oTbl As Table)
Dim oCell As Cell, oRng As Range
Dim lngRow As Long, lngSplit As Long
If Not oTbl.Uniform Then
For Each oCell In oTbl.Range.Cells
If oCell.RowIndex = oTbl.Rows.Count Then Exit For
Set oRng = oCell.Range
oRng.Select
Selection.MoveDown Unit:=wdLine, Count:=1
On Error GoTo Err_Cell
If Selection.Information(wdWithInTable) Then
lngSplit = Selection.Cells(1).RowIndex - oRng.Cells(1).RowIndex
Else
lngSplit = oTbl.Rows.Count - oRng.Cells(1).RowIndex + 1
End If
Err_RE:
If lngSplit > 1 Then oCell.Split NumRows:=lngSplit
Next oCell
End If
lbl_Exit:
Exit Sub
Err_Cell:
lngSplit = 1
Resume Err_RE
End Sub
Sub MarkNonUniformity(oTbl As Table)
'A basic Word macro coded by Greg Maxey
Dim oRow As Row, oCol As Column
Dim bVM As Boolean, bHM As Boolean, bBoth As Boolean
bVM = False: bHM = False: bBoth = False
With oTbl
If Not .Uniform Then
On Error Resume Next
Set oRow = .Rows(1)
If Err.Number = 5991 Then bVM = True
Err.Clear
Set oCol = oTbl.Columns(1)
If Err.Number = 5992 Then bHM = True
If bVM And bHM Then bBoth = True
Select Case True
Case bBoth: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorGreen
Case bVM: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorRose
Case bHM: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorPaleBlue
End Select
End If
End With
lbl_Exit:
Exit Sub
End Sub