Delete columns where all cells are empty

RogerC

Well-known Member
Joined
Mar 25, 2002
Messages
533
My spreadsheet has 350 columns, many of which contain only a header. Other columns may contain both values and blank cells.

Is there a non-VBA method to find and delete all columns where there are only blank cells below the header?

The 'Go To... Blanks' method to find blank cells won't work, because I don't want blank cells deleted from columns where some cells have data.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,849
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
I am not aware of a non VBA way to do that.
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,159
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
But very simple with VBA.
 

RogerC

Well-known Member
Joined
Mar 25, 2002
Messages
533
But very simple with VBA.
Well, VBA I guess it will have to be.

I'm not finding how to do it with columns. I did find this code Michael M provided for a similar need on rows, but not sure how to modify for columns...

VBA Code:
Sub MM1()
Dim lr As Long, r As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 1 Step -1
If WorksheetFunction.CountA(Range(Cells(r, 1), Cells(r, 30))) = 0 Then
Rows(r).Delete
End If
Next r
Application.ScreenUpdating = True
End Sub
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,849
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

What row is the header in?
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,849
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

Try the following:

VBA Code:
Sub Delete_Columns_In_ActiveSheet_With_Only_BlankCells_Below_Header()       'AlphaFrog Inspired code to delete columns if column is all blank after header row 1
'
    Dim col                 As Long
    Dim TotalColumnWidth    As Long
'
    TotalColumnWidth = 350                                                  ' <-- Set this value to desired column width value
'
    Application.ScreenUpdating = False                                      ' Turn Screen Updating Off
'
    For col = TotalColumnWidth To 1 Step -1                                 ' Loop Columns backwards
        If Application.CountA(Columns(col)) = 1 Then Columns(col).Delete    '   Delete found column if all blank values found below Row 1
    Next col                                                                ' Loop back to check next column for all blank cells below Row 1
'
    Application.ScreenUpdating = True                                       ' Turn Screen Updating back On
End Sub
 

RogerC

Well-known Member
Joined
Mar 25, 2002
Messages
533
Thanks johnnyL.

Your code seems to work with the exception of 5 columns. After running the macro the total number of columns went from 350 to 133. However, 5 columns within those 133 contain only Blank cells.

Of course, deleting them manually is manageable now, but do you have any idea why they would not have been deleted?
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
21,104
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Are the cells truly "blank" or are they blank because of a formula result...OR actually contain formulas?
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
21,104
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
If they are contain a formula that returns blank try using
VBA Code:
Sub Delete_Columns_In_ActiveSheet_With_Only_BlankCells_Below_Header()
lc = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
    Application.ScreenUpdating = False
    For col = lc To 1 Step -1
        If Application.CountA(Range(Cells(1, col), Cells(2, col))) <> 1 Then Columns(col).Delete
    Next col
    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,148,179
Messages
5,745,199
Members
423,932
Latest member
pablo2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top