Delete columns where all cells are empty

[RogerC]

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.

 

[johnnyL]

I am not aware of a non VBA way to do that.

 

[rlv01]

But very simple with VBA.

 

[RogerC]

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]

What row is the header in?

 

[RogerC]

Thank you johnnyL. Headers are in row 1.

 

[johnnyL]

Try the following:

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]

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]

Are the cells truly "blank" or are they blank because of a formula result...OR actually contain formulas?

 

[Michael M]

If they are contain a formula that returns blank try using

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