How Can I Quickly Identify a Blank Table Column in Word?

Question

I have a lot of large tables in automatically generated word documents and I want to delete columns that have no values in them. They will all have headers, so essentially I need to check the values of rows 2 to the end or just get the whole column in a string and check after the first chr(14) which I understand is the column marker.

Is this possible without looping through the cells, row by row, which appears to be slow, or selecting the column which seems to cause the screen to have issues and the UI freezes, sometimes crashing Word.

Answer 1

What you want to do is perfectly possible but can run into an issue. There is a difference in the number of cells in the selection range reported (and consequently the text to process) depending on whether you use

selection.cells

or

selection.range.cells

The former works as expected, the latter does not.

The code below deletes columns in the way in which you describe and also includes debug.print statements to demonstrate the problem.

I've tested the code on a 5x6 table. Your experience may differ.

Sub DeleteEmptyTableColumns(this_table As Word.Table)
    Dim my_cells                As Range
    Dim my_column               As Long
    Dim my_text                 As String
    Dim my_last_row             As Long

    ' Assumes that the Table is uniform
    my_last_row = this_table.Rows.Count
    Application.ScreenUpdating = False

    With this_table
        For my_column = .Columns.Count To 1 Step -1
            DoEvents
            Set my_cells = .Range.Document.Range( _
                Start:=.Cell(2, my_column).Range.Start, _
                End:=.Cell(my_last_row, my_column).Range.End)
            ' We have to use selection to get the correct text
            my_cells.Select

            Debug.Print
            ' Wrong numbers and text
            Debug.Print my_cells.Cells.Count
            Debug.Print my_cells.Text

            ' Correct information
            Debug.Print Selection.Cells.Count
            Debug.Print Selection.Text

            ' Back to the wrong information
            Debug.Print Selection.Range.Cells.Count
            Debug.Print Selection.Range.Text

            my_text = Selection.Text

            ' Add other replacments as required.
            my_text = Replace(my_text, " ", vbNullString)
            my_text = Replace(my_text, vbCrLf, vbNullString)
            my_text = Replace(my_text, Chr$(13), vbNullString)
            my_text = Replace(my_text, Chr$(7), vbNullString)

            If Len(my_text) = 0 Then
                this_table.Columns(my_column).Delete

            End If

        Next

    End With

    Application.ScreenUpdating = True

End Sub