Delete Blank Columns

[BSII]

I have a spreadsheet with some basic column headers in row 1 and data in some
cells below the headers (range is actually flexible). After I divide up the
data into different worksheets, many of the columns are left blank except for
the headers and I'm looking for a way to search the range (A1-Z60), find the
empty columns, and delete them. For example, I'd want to delete columns "B"
and "D" in the following table as they only have the headers in Row1 with no
data below.

A B C D
1 H1 H2 H3 H4
2 1 2
3 33 44

I have found lots of references to deleting empty rows, but not columns. I
was able to find a way to hide empty column (from one of the great
programmers that post help for us beginners) and this works great, but I have
another macro that formats the header colmun which then unhides the empty
columns, so I really need to just delete them.

Any help would be appreciated.

BSII (Michael Lindauer)

 

[Martin Fishlock]

Hi BS2:

Look at this. It is really the same as rows except that you look at columns:

Option Explicit

Sub DeleteColumns()
Const cszStartCell As String = "A1"
Dim ws As Worksheet
Dim lCol As Long
Dim lColEnd As Long, lColBeg As Long
Dim lRowEnd As Long, lRowBeg As Long


On Error GoTo ErrorReset
Application.ScreenUpdating = False

Set ws = ActiveSheet

' as fixed range not really needed but better
With ws.Range(cszStartCell).CurrentRegion
lColBeg = .Column
lColEnd = lColBeg + .Columns.Count - 1
lRowBeg = .Row + 1 ' ad one to exclude header
lRowEnd = lRowBeg + .Rows.Count - 1
End With
' loop through columns backwards
For lCol = lColEnd To lColBeg Step -1
' use the worksheet function counta
If Application.WorksheetFunction.CountA( _
ws.Range(ws.Cells(lRowBeg, lCol), _
ws.Cells(lRowEnd, lCol))) = 0 Then
ws.Columns(lCol).Delete
End If
Next lCol
ErrorReset:
Application.ScreenUpdating = True
End Sub

 

[Tom Ogilvy]

Sub DeleteColumns()
Dim i as Long
for i = 26 to 1 step - 1
if application.Counta(cells(2,i).Resize(59,1)) = 0 then
columns(i).Delete
end if
Next
End Sub

 

[BSII]

Tom - this worked like a charm. For my understanding, can you break down
what the code is actually doing as I'm not familiar with some of the commands.

Thanks again,
Mike

 

[Tom Ogilvy]

Sub DeleteColumns()
Dim i as Long
' loop from Z to A
for i = 26 to 1 step - 1
' counta counts the number of cells with an entry
' Cells(2,i).Resize(59,1) refers to cells in rows 2 to 60 of that column
' 59,1 means 59 rows and 1 column
if application.Counta(cells(2,i).Resize(59,1)) = 0 then
' delete the column if there are no entries
columns(i).Delete
end if
Next
End Sub