Share via

How can I tell if a table in Word has merged cells?

Anonymous
2012-07-24T20:24:55+00:00

I have a Word document with a dozen tables. After editing by the users, there may be blank lines in the tables so I iterate through the tables and use the following code to delete rows that are entirely blank.

            For i = SourceTable.Rows.Count To StartRow Step -1

                Set Col1 = SourceTable.Cell(i, 1).Range

                'Exclude the paragraph marker from the contents

                Col1.End = Col1.End - 1

                Set Col2 = SourceTable.Cell(i, 2).Range

                Col2.End = Col2.End - 1

                'if the row is blank then delete the row

                If Len(Col1) = 0 And Len(Col2) = 0 Then

                    SourceTable.Rows(i).Delete

                End If

            Next i

This worked well until a new table was added in which some of the cells in the first column were merged to form labels for multiple rows of cells in column 2. When the code executes it generates an error in the Set Col1 line because the last cell in the first column is a merged cell.

Is there a simple way to test for the existance of merged cells in a table?

Is there a way to delete a row that is blank except for the merged cell in column 1?

There may be other columns in the table that may or may not contain data, but it is only the contents of columns 1 and 2 that determine if a row is to be deleted.

Microsoft 365 and Office | Word | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

3 answers

Sort by: Most helpful
Most helpful Newest Oldest
  1. Andreas Killer 144.1K Reputation points Volunteer Moderator
    2012-07-25T16:06:11+00:00

    The output is okay, that's normal.

    Another try with the code below, please.

    Andreas.

    Option Explicit

    Sub Main()

      DeleteEmptyRowsInTable ThisDocument.Tables(1)

    End Sub

    Sub DeleteEmptyRowsInTable(ByVal T As Table)

      'Delete all empyt rows in the given table, can contain vertical and horizontal merged cells

      Dim C As Cell

      Dim R As Integer, i As Integer

      Dim Stack() As Integer

      ReDim Stack(0 To 0) As Integer

      With T

        'The FOR EACH visits the cells in ascending order

        R = 1

        For Each C In .Range.Cells

          'Is the current row greater then our row pointer?

          If C.RowIndex > R Then

            'Yes, we can delete the last row, save the row

            ReDim Preserve Stack(0 To UBound(Stack) + 1)

            Stack(UBound(Stack)) = R

            'Go one with the next row

            R = R + 1

          End If

          'Must we check this row?

          If C.RowIndex = R Then

            'Skip this row if the cell is not empty

            If Len(TrimWhite(C.Range.Text)) > 0 Then R = R + 1

          End If

        Next

        'Delete all empty rows from bottom to top

        For R = UBound(Stack) To 1 Step -1

          'Note:

          '  .Rows(Stack(r)).Delete

          'raises a RTE 5991 if the table contains vertical merged cells

          '.Cell.Split

          Set C = Nothing

          For i = 1 To .Columns.Count

            Set C = GetCell(T, Stack(R), i)

            If Not C Is Nothing Then Exit For

          Next

          If Not C Is Nothing Then

            C.Select

            Selection.Rows.Delete

          End If

        Next

      End With

    End Sub

    Private Function TrimWhite(ByVal S As String) As String

      'Return a string with white space removed

      Dim i As Long

      For i = 1 To Len(S)

        If Asc(Mid$(S, i, 1)) < 32 Then Mid$(S, i, 1) = vbNullChar

      Next

      TrimWhite = Replace$(S, vbNullChar, "")

    End Function

    Private Function GetCell(ByVal T As Table, ByVal Row As Long, ByVal Column As Long) As Cell

      On Error Resume Next

      Set GetCell = T.Cell(Row, Column)

    End Function

    Was this answer helpful?

    0 comments
  2. Anonymous
    2012-07-25T14:10:38+00:00

    I'm not sure just how your code works, so I put in a few debug.print lines.

    For a table with 2 columns where the columns are merged for the first two lines, the debug.print output was:

    ColumnIndex 1  RowIndex 1  Row pointer 1

    ColumnIndex 1  RowIndex 2  Row pointer 2

    ColumnIndex 1  RowIndex 3  Row pointer 3

    ColumnIndex 2  RowIndex 3  Row pointer 4

    ColumnIndex 1  RowIndex 4  Row pointer 4

    ColumnIndex 2  RowIndex 4  Row pointer 5

    The column index 2 only shows up on the unmerged 3rd and 4th rows.

    For a table with 2 columns and cells merged in the first column, the debug.print output was:

    ColumnIndex 1 RowIndex 1 Row pointer 1

    ColumnIndex 2 RowIndex 1 Row pointer 2

    ColumnIndex 1 RowIndex 2 Row pointer 2

    ColumnIndex 2 RowIndex 2 Row pointer 2

    [edited]

    ColumnIndex 1 RowIndex 6 Row pointer 6

    ColumnIndex 2 RowIndex 6 Row pointer 7

    ColumnIndex 2 RowIndex 7 Row pointer 7

    ColumnIndex 2 RowIndex 8 Row pointer 8

    ColumnIndex 2 RowIndex 9 Row pointer 9

    [edited]

    ColumnIndex 2 RowIndex 18 Row pointer 18

    ColumnIndex 1 RowIndex 19 Row pointer 19

    ColumnIndex 2 RowIndex 19 Row pointer 19

    In this case, the column index of 1 shows up for the unmerged rows and for the first row with a merged cell (row 6), but not for the subsequent rows where the cell in column 1 is part of the merged cell (rows 7 through 18).

    For a table with 3 columns and cells merged in the first column, the debug.print output was:

    ColumnIndex 1 RowIndex 1 Row pointer 1

    ColumnIndex 2 RowIndex 1 Row pointer 2

    ColumnIndex 3 RowIndex 1 Row pointer 2

    ColumnIndex 1 RowIndex 2 Row pointer 2

    ColumnIndex 2 RowIndex 2 Row pointer 2

    ColumnIndex 3 RowIndex 2 Row pointer 3

    [edited]

    ColumnIndex 1 RowIndex 6 Row pointer 6

    ColumnIndex 2 RowIndex 6 Row pointer 7

    ColumnIndex 3 RowIndex 6 Row pointer 7

    ColumnIndex 2 RowIndex 7 Row pointer 7

    ColumnIndex 3 RowIndex 7 Row pointer 8

    ColumnIndex 2 RowIndex 8 Row pointer 8

    ColumnIndex 3 RowIndex 8 Row pointer 9

    ColumnIndex 2 RowIndex 9 Row pointer 9

    ColumnIndex 3 RowIndex 9 Row pointer 10

    [edited]

    ColumnIndex 2 RowIndex 18 Row pointer 18

    ColumnIndex 3 RowIndex 18 Row pointer 19

    ColumnIndex 1 RowIndex 19 Row pointer 19

    ColumnIndex 2 RowIndex 19 Row pointer 19

    ColumnIndex 3 RowIndex 19 Row pointer 20

    As before, the column index of 1 shows up for the unmerged rows and for the first row with a merged cell (row 6), but not for the subsequent rows where the cell in column 1 is part of the merged cell (rows 7 through 18).

    The run time errors are generated when you try to address a cell that has been merged except for the top left merged cell.

    Since you can delete an entire row from the user interface even if it contains a merged cell, it should be possible to trap the error and still delete the entire row using VBA.

    Can anyone provide some guidance.

    Was this answer helpful?

    0 comments
  3. Andreas Killer 144.1K Reputation points Volunteer Moderator
    2012-07-25T10:09:53+00:00

    I have found a solution that works with vertical and horizontal merged cells.

    But IMHO it is not perfect, because I must use SELECT and SELECTION to delete the row, otherwise a RTE 5991 occurs.

    If someone knows a way without using SELECT, please let me know.

    Andreas.

    Option Explicit

    Sub Main()

      DeleteEmptyRowsInTable ThisDocument.Tables(1)

    End Sub

    Sub DeleteEmptyRowsInTable(ByVal T As Table)

      'Delete all empyt rows in the given table, can contain vertical and horizontal merged cells

      Dim C As Cell

      Dim R As Integer

      Dim Stack() As Integer

      ReDim Stack(0 To 0) As Integer

      With T

        'The FOR EACH visits the cells in ascending order

        R = 1

        For Each C In .Range.Cells

          'Is the current row greater then our row pointer?

          If C.RowIndex > R Then

            'Yes, we can delete the last row, save the row

            ReDim Preserve Stack(0 To UBound(Stack) + 1)

            Stack(UBound(Stack)) = R

            'Go one with the next row

            R = R + 1

          End If

          'Must we check this row?

          If C.RowIndex = R Then

            'Skip this row if the cell is not empty

            If Len(TrimWhite(C.Range.Text)) > 0 Then R = R + 1

          End If

        Next

        'Delete all empty rows from bottom to top

        For R = UBound(Stack) To 1 Step -1

          'Note:

          '  .Rows(Stack(r)).Delete

          'raises a RTE 5991 if the table contains vertical merged cells

          .Cell(Stack(R), 1).Select

          Selection.Rows.Delete

        Next

      End With

    End Sub

    Private Function TrimWhite(ByVal S As String) As String

      'Return a string with white space removed

      Dim i As Long

      For i = 1 To Len(S)

        If Asc(Mid$(S, i, 1)) < 32 Then Mid$(S, i, 1) = vbNullChar

      Next

      TrimWhite = Replace$(S, vbNullChar, "")

    End Function

    Was this answer helpful?

    0 comments