Need macro to delete a column with a blank cell

dwirony · #1 10-20-2016, 09:50 AM

Hello all,

I need a word macro to delete a column in any given table that has any blank cell within it. For example, my tables are generating and sometimes columns generate that have only a header but no information in the cell below it because there is none. I need to delete this entire column. I have this macro already but it only deletes a row/column if the entire row/column is empty; How can I modify it?

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

macropod · #2 10-20-2016, 01:25 PM

Try:

Code:

Sub DeleteEmptyTableRowsAndColumns()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For i = .Rows.Count To 1 Step -1
      With .Rows(i)
        If Len(.Range) = .Cells.Count * 2 + 2 Then .Delete
      End With
    Next i
    With .Range
      For i = .Cells.Count To 1 Step -1
        On Error Resume Next
        If Len(.Cells(i).Range) = 2 Then
          .Columns(.Cells(i).ColumnIndex).Delete
        End If
      Next i
    End With
  End With
Next Tbl
Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

PS: When posting code, please use the code tags, inserted via the # button on the posting menu.

PPS: Note also how much simpler and more efficient the row deletion code can be.

dwirony · #3 10-20-2016, 01:31 PM

It works! Thank you so much!

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
If value of cell A Matches a value in a Range of cells (column) then add value of cell A to cell C	rick10r	Excel	1	07-05-2016 12:07 PM
Identify last blank cell in column	mbesspiata	Excel	0	02-27-2015 11:29 AM
Return Sum value of one column from cells not blank in another column	zulugandalf	Excel	3	08-14-2014 03:37 AM
Macro to remove blank column	netchie	Word VBA	4	03-14-2013 02:22 PM
How can I delete the content of a cell in column if the cell value is more than 1000?	Learner7	Excel	2	06-27-2011 05:44 AM