How to delete blank rows or rows with spaces in a table that has one or more cells vertically merged?

Question

I need a vba script or help on what I'm writing in order not to exit the iteration when the table contains vertically and horizontally merged cells.

Example of the table:

---------
|   |   | <-- I don't want these rows deleted, they can be skipped
|---|   |
|   |   | <-- I don't want these rows deleted, they can be skipped
|---|---|
|   |   | <-- this must be checked for emptiness in order to decide to delete or not
|---|---|
|   |   | <-- this must be checked for emptiness in order to decide to delete or not
|---|---|

My script in VBA so far:

Public Sub DeleteEmptyRows()
    Dim c As String
    c = ""
    Dim oTable As Table, oRow As Integer
    ' Specify which table you want to work on.
    For Each oTable In ActiveDocument.Tables

        For oRow = oTable.Rows.Count To 1 Step -1
            'On Error GoTo NextIteration
            MsgBox oTable.Rows(oRow).Range.Text
            'If Len(oTable.Rows(oRow).Range.Text) = oTable.Rows(oRow).Cells.Count * 2 + 2 Then
            If Len(Replace(oTable.Rows(oRow).Range.Text, Chr(13) & Chr(7), vbNullString)) = 0 Then
                oTable.Rows(oRow).Delete
            End If
        Next oRow
    Next oTable
    MsgBox c
End Sub

How to reproduce the error: Create a 5x5 table. Select cell(0,0) and cell(1, 0) and merge them. Select cell(0, 1) and cell(0, 2) and merge. Run the script and get the 5991 error..

The problem is that I get a run-time error 5991: Can't access to individual lines in this collection because there are vertically merged cells.

I really don't know what to do because if this error happens no row will be looked after. Usually my tables have a header that has vertically merged cells and the body rows are not, so I cannot do anything...

for Word.

CuberChase · Accepted Answer

This is what I came up with to delete all rows in a table which do not contain any merged cells and do not contain any text.

The problem with tables containing merged cells is not so much deleting the rows but identifying which cells are actually merged and then removing whats left.

The way I approached this was to loop through all the cells in table and for each row workout how many columns are counted (horizontally merged cells and cells vertically merged from above are ignored) and thanks to this page (http://word.mvps.org/FAQs/MacrosVBA/GetRowColSpan.htm) if any of the cells in the row are the top of a vertically merged cell we can tell.

Finally we also check if there is any text in the row.

This is the code I came up with, hopefully with the comments it should be straightforward. Unfortunately due to the way Word deals with this stuff the cells have to Selected rather than just using ranges - this isn't ideal because it significantly slows things down. It has worked in all my tests.

Option Explicit

Public Sub DeleteEmptyRows()
    Dim oTable As Table, oCol As Integer, oRows As Integer
    Dim iMergeCount() As Integer, dCellData() As Double
    Dim MyCell As Cell
    Dim iCurrentRow As Integer, iRowCounter As Integer

    'Watching this happen will slow things down considerably
    Application.ScreenUpdating = False

    ' Specify which table you want to work on.
    For Each oTable In ActiveDocument.Tables
        'We need to store the number of columns to determine if there are any merges
        oCol = oTable.Columns.Count

        ReDim dCellData(1 To oTable.Rows.Count, 1 To 3)
        'The first column will count the number of columns in the row if this doesn't match the table columns then we have merged cells
        'The second column will count the vertical spans which tells us if a vertically merged cell begins in this row
        'The third column will count the characters of all the text entries in the row.  If it equals zero it's empty.

        iCurrentRow = 0: iRowCounter = 0
        For Each MyCell In oTable.Range.Cells
            'The Information property only works if you select the cell. Bummer.
            MyCell.Select

            'Increment the counter if necessary and set the current row
            If MyCell.RowIndex <> iCurrentRow Then
                iRowCounter = iRowCounter + 1
                iCurrentRow = MyCell.RowIndex
            End If

            'Check column index count
            If MyCell.ColumnIndex > VBA.Val(dCellData(iRowCounter, 1)) Then dCellData(iRowCounter, 1) = MyCell.ColumnIndex

            'Check the start of vertically merged cells here
            dCellData(iRowCounter, 2) = dCellData(iRowCounter, 2) + (Selection.Information(wdEndOfRangeRowNumber) - Selection.Information(wdStartOfRangeRowNumber)) + 1

            'Add up the length of any text in the cell
            dCellData(iRowCounter, 3) = dCellData(iRowCounter, 3) + VBA.Len(Selection.Text) - 2 '(subtract one for the table and one for cursor(?))

            'Just put this in so you can see in the immediate window how Word handles all these variables
            Debug.Print "Row: " & MyCell.RowIndex & ", Column: " & MyCell.ColumnIndex & ", Rowspan = " & _
                (Selection.Information(wdEndOfRangeRowNumber) - _
                Selection.Information(wdStartOfRangeRowNumber)) + 1
        Next MyCell

        'Now we have all the information we need about the table and can start deleting some rows
        For oRows = oTable.Rows.Count To 1 Step -1
            'Check if there is no text, no merges at all and no start of a vertical merge
            If dCellData(oRows, 3) = 0 And dCellData(oRows, 1) = oCol And dCellData(oRows, 2) = oCol Then
                'Delete the row (we know it's totally unmerged so we can select the first column without issue
                oTable.Cell(oRows, 1).Select
                Selection.Rows.Delete
            End If
        Next oRows
    Next oTable

    Application.ScreenUpdating = True
End Sub

How to delete blank rows or rows with spaces in a table that has one or more cells vertically merged?

Answers (2)

Related Questions