Creating VBA Code to Delete Empty Column in Table

Faugs · #1 08-05-2014, 10:26 AM

Hi all,

I've been stuck on this for very long and would appreciate any help whatsoever!

I've created a mail merge that populates a table in Word. The table will be populated with the account's sales for 1 of 6 eligible product groups (see below)

However, if the account has no sales for a specific product group (Mobile PC - Column 2), then some of the cells are left blank (see below).

I'd like to create a VBA code that would detect if any cells are blank within the table and if so, delete the entire column (see final result below, Mobile PC column is deleted).

I have been deleting each column manually in the past, but have now been tasked with completing these letters once a week. We have thousands of accounts which means I have to manually delete thousands of columns each week.

Any help would be so appreciated, thank you!

macropod · #2 08-05-2014, 08:41 PM

What you describe could be done with a macro like:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For i = .Columns.Count To 2 Step -1
      If Len(.Cell(2, i).Range.Text) = 2 Then .Columns(i).Delete
    Next
  End With
Next
Application.ScreenUpdating = True
End Sub

Faugs · #3 08-07-2014, 06:52 AM

Thank you for the assistance, Macropod! You have led me in the right direction, however I am not there just yet.

I have found a similar macro that will remove a table's column ONLY if the entire column is completely blank (see below).

Code:

Sub DeleteEmptyTablerowsandcolumns()
Application.ScreenUpdating = False
Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Columns.Count
For i = n To 1 Step -1
fEmpty = True
For Each cel In Tbl.Columns(i).Cells
If Len(cel.Range.Text) > 2 Then
fEmpty = False
Exit For
End If
Next cel
If fEmpty = True Then Tbl.Columns(i).Delete
Next i
Next Tbl
End With
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Rows.Count
For i = n To 1 Step -1
fEmpty = True
For Each cel In Tbl.Rows(i).Cells
If Len(cel.Range.Text) > 2 Then
fEmpty = False
Exit For
End If
Next cel
If fEmpty = True Then Tbl.Rows(i).Delete
Next i
Next Tbl
End With
Set cel = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

The results of this code are as follows:

The second column is completely blank, so the macro deletes the entire column.

HOWEVER, I would like to tweak the VBA code above to check if ANY cells are blank within the table. If there is even 1 blank cell, delete the ENTIRE column.

See desired results below (you can see Column 2, cell D is blank, so the entire column should be deleted):

If you could help me tweak the VBA code above to complete this task, I would be very appreciative!!!

Cosmo · #4 08-07-2014, 12:52 PM

Untested, but I believe you should be able to change the following lines:

Code:

For i = n To 1 Step -1
fEmpty = True
For Each cel In Tbl.Columns(i).Cells
If Len(cel.Range.Text) > 2 Then
fEmpty = False
Exit For
End If
Next cel
If fEmpty = True Then Tbl.Columns(i).Delete
Next i

to

Code:

For i = n To 1 Step -1
fEmpty = False
For Each cel In Tbl.Columns(i).Cells
If NOT (Len(cel.Range.Text) > 2) Then
fEmpty = True
Exit For
End If
Next cel
If fEmpty = True Then Tbl.Columns(i).Delete
Next i

Faugs · #5 08-07-2014, 02:01 PM

Thank you very much for your response, Cosmo! I also appreciate your response too, macropod!

I was able to get it to work with the following VBA:

Code:

Sub DeleteEmptyTablerowsandcolumns()
Application.ScreenUpdating = False
    Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean
    
    With ActiveDocument
        For Each Tbl In .Tables
        n = Tbl.Columns.Count
            For i = n To 1 Step -1
                fEmpty = False
                For Each cel In Tbl.Columns(i).Cells
                    If Len(cel.Range.Text) <= 2 Or IsNull(cel.Range.Text) Or IsEmpty(cel.Range.Text) Or cel.Range.Text = "" Then
                        fEmpty = True
                    End If
                    Next cel
                    If fEmpty = True Then Tbl.Columns(i).Delete
                Next i
        Next Tbl
    End With
End Sub

macropod · #6 08-07-2014, 03:29 PM

You could use:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long
For Each Tbl In ActiveDocument.Tables
  With Tbl.Range
    For i = .Cells.Count To 1 Step -1
      .Cells(i).Range.Select
      If Len(.Cells(i).Range.Text) = 2 Then .Columns(.Cells(i).ColumnIndex).Delete
      If i > .Cells.Count Then i = .Cells.Count
    Next
  End With
Next
Application.ScreenUpdating = True
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to delete all empty rows from all tables	braddgood	Word VBA	15	10-02-2015 01:54 PM
Delete row when 2 column has no value	Rok	Word VBA	1	11-26-2013 01:59 AM
Unable to open or delete an empty folder	Zimm	Windows	4	11-19-2013 05:07 PM
Delete lots of empty space between paragraphs.	FieldTechnician	Word	4	10-25-2013 01:14 PM
Macro to delete rows with all empty cells	ubns	Excel Programming	2	08-14-2012 02:01 AM