Delete columns with all empty cells and header

Question

The code below deletes columns with all empty cells in the entire column. I need to alter it to delete columns with all empty cells in the entire column, only if there is a column header. I want the columns with no header and no cell data to remain.

Thanks for any assistance!

Dim X As Long, LastRow As Long, LastCol As Long
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells(1, Columns.count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  For X = LastCol To 1 Step -1
    If Cells(1, X).Value = Join(Application.Transpose(Cells(1, X).Resize(LastRow)), "") Then Columns(X).Delete
  Next
  Application.ScreenUpdating = True

Darrell H Darrell H · Accepted Answer · 2018-07-25T19:36:41

Assuming that row 1 is your header row...

Dim X As Long, LastRow As Long, LastCol As Long

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Application.ScreenUpdating = False

For X = LastCol To 1 Step -1
    LastRow = Cells(Rows.Count, X).End(xlUp).Row
    If LastRow = 1 And Not IsEmpty(Cells(1, X)) Then
        Columns(X).Delete
    End If

Next

Application.ScreenUpdating = True

Delete columns with all empty cells and header

1 Answers