Macro that deletes empty columns with no data in all worksheets in a workbook

[eskay3]

Hi All,

I'm trying to get the macro to delete columns that don't contain any data.

The data I'm using has 120 worksheets with several titled columns of blank data. This macro works for 1 sheet but when I try and apply it to multiple worksheets it won't work.

Can someone tell me what I'm doing wrong?

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
' for every worksheet
Dim Ws As Worksheet

For Each Ws In ActiveWorkbook.Worksheets

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:
Next Ws
End Sub

Thank you for any help

[LeoTaxi]

Code between code tags like this

Please Login or Register  to view this content.

Kind regards
Leo

[MarvinP]

Hi eskay and welcome to the forum,

Here is the code I'd use to do your problem. My assumption is that the column heads are all in the first row on each sheet.

Please Login or Register  to view this content.