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

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