Macro To Delete Spreadsheet Columns if no data in column

Hi,

I need a routine that will go across and delete any columns in a spreadsheet that don't contain any data. The spreadsheet will always be from columns A:BB. There are column headings on row 1 going across.

Thanks for your help - I very much appreciate this forum. It has helped me out greatly!

Gary

Thank you for your assistance, Shasur, but I didn't want to delete any rows, only columns without any data.

-Gary

I found this code on another site, and it appears to work. So I thought I would post it.

Sub DelEmptyColumn()
For i = 256 To 1 Step -1
If Application.CountA(Columns(i)) = 1 Then
If Cells(1, i).Value <> "" Then Columns(i).Delete
End If
Next
End Sub

I hate to be picky ... but, I think you're better off with a more generic routine; I'd do a run on all columns A to BB (use the lastcell property) and for all rows check the content of each column using a parameter that concatentates the value of each row within the column, aborting when the parameter is not empty/blank and going to the next one ...

Something like:

Sub DeleteEmptyColumns()

Dim j As Integer
Dim k As Integer
Dim intLastRow As Integer
Dim intLastCol As Integer
Dim booColumnEmpty As Boolean
Dim varContent As Variant

intLastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
intLastCol = Range("A1").SpecialCells(xlCellTypeLastCell).Column

For j = 1 To intLastCol
varContent = ""
For k = 2 To intLastRow
varContent = varContent & Cells(k, j)
If varContent = "" Then
'continue:
Else
GoTo SkipColumn
End If
Next k
Cells(k, j).EntireColumn.Delete
j = j - 1
intLastCol = intLastCol - 1
If intLastCol < 1 Then GoTo LastColumnExit
SkipColumn:
Next j

LastColumnExit:

End Sub

I'm sure there's a more elegant solution, but hope this helps.

Aussie James.

Thank you - I appreciate your help. It works very well.

Gary

Hi kat ... hmmm - what do you mean "no effect" The code sample I wrote doesn't check for empty rows, it loops through every column then checks every cell (row by row) in the column aggregating the text values to a holding variable and if that variable becomes non-empty before the last row of the spreadsheet (that has data in it) then the column is non-empty and it goes to the next one. If the variable remains empty to the bottom of the column, the column is empty and it is deleted ...

In any case ... I had a thought about making this more elegant ... How's this:

========

Sub DeleteEmptyColumns2()

Dim intLastCol As Integer
Dim lngLastRow As Long
Dim i As Integer

intLastCol = Range("A1").SpecialCells(xlCellTypeLastCell).Column

For i = 1 To intLastCol
Cells(1, i).Select
lngLastRow = Cells(1, i).End(xlDown).Row
If lngLastRow = 65536 And IsEmpty(Cells(lngLastRow, i)) Then
Cells(1, i).EntireColumn.Delete
i = i - 1
intLastCol = intLastCol - 1
If i > intLastCol Then GoTo BreakLoop
End If
Next i

BreakLoop:

End Sub

========

Let me know if you still have problems running this ...

Aussie James.

Oops! I didn't account for the possibility that the first cell of the column isn't blank, which you'll need if there's no header row. So just change the corresponding decision line in the code above to:

If lngLastRow = 65536 And IsEmpty(Cells(lngLastRow,i)) And IsEmpty(Cells(1,i) Then .... etc etc.

Cheers,

AussieJames.