vbams-wordms-officeword-table

How to split all the vertically merged cells in Microsoft Word table using word vba?


I have a word table which contains numerous vertical merges.

I need to split all the cells which are merged, into individual cells with the previous value in merged cells.


Solution

  • I searched through a lot of reference, but couldn't find any other shorter way to split all vertical merging in Table cell in Word.

    This function will take the first table in word, and will remove all the vertical merges for all cells for the table in MS Word.

    Function SplitVerticalMerge()
        'Created by Chandraprakash [Yoh]
        Dim i As Long, j As Long, k As Long, cols As Long, m As Long
        Dim sData() As Variant
        Dim oTable As Table
        Dim oCell As Cell
        Dim oRng As Range
        Dim sText As String
        Dim sRow As String
        Dim iRow As Long
    
        'Rows of Merged and NonMerged cells in Table
        Dim oColl1 As New Collection
    
        'Row with number of merged cells in Table (Vertical Split Number)
        Dim oColl2 As New Collection
    
        Set oTable = ActiveDocument.Tables(1)
        With oTable
    
            'Load all the Table cell index
            ReDim sData(1 To .Rows.Count, 1 To .Columns.Count)
            Set oCell = .Cell(1, 1)
            Do While Not oCell Is Nothing
                sData(oCell.RowIndex, oCell.ColumnIndex) = oCell.RowIndex & "," & oCell.ColumnIndex
                Set oCell = oCell.Next
            Loop
    
            '1. Mark the merged cell as "X"
            '2. Mark the non merged cell as "A"
            '3. Load the result for each row to Collection1
            For i = 1 To UBound(sData)
                sRow = ""
                For j = 1 To UBound(sData, 2)
                    sRow = sRow & IIf(IsEmpty(sData(i, j)), "X", "A") ' & "|"
                Next j
                oColl1.Add sRow
            Next i
    
            For cols = 1 To oTable.Columns.Count
                'Load one by one Row with number of merged cells in Table (Vertical Split Number)
                Set oColl2 = Nothing
                j = 1
                For i = oColl1.Count To 1 Step -1
                    '"X" - Merged
                    If Mid(oColl1(i), cols, 1) = "X" Then
                        j = j + 1
                        k = j
                    '"A" - NotMerged
                    Else
                        k = j
                        j = 1
                    End If
                    If j = 1 Then oColl2.Add k
                Next i
    
                iRow = oTable.Columns(cols).Cells.Count
                k = iRow
                For j = 1 To oColl2.Count
                    For i = oColl2.Count To 1 Step -iRow
                        'cols - Column Number
                        'k - cell row number in column (cols)
                        'j - Split number for the cell (k)
    
                        'Split the cell by above attributes defined
                        oTable.Columns(cols).Cells(k).Split oColl2(j), 1
    
                        '1. Enter if merged cell is split (j>1)
                        '2. Will fill the values for split empty cell with previous merged cell value
                        If oColl2(j) > 1 Then
                            For m = 1 To oColl2(j) - 1
                                oTable.Columns(cols).Cells(k + m).Range.Text = oTable.Columns(cols).Cells(k).Range.Text
                            Next m
                        End If
    
                        k = k - 1
                    Next i
                Next j
            Next cols
    
            'To avoid application freezing
            DoEvents
        End With
    
    lbl_Exit:
        Set oColl1 = Nothing
        Set oColl2 = Nothing
    
        Set oTable = Nothing
        Set oCell = Nothing
        Set oRng = Nothing
        Exit Function
    End Function
    

    Reference: Base code by Graham Mayor - MS MVP (Word) URL: http://www.vbaexpress.com/forum/showthread.php?59760-Unmerging-Vertically-merged-cells