Delete Blank Column but skip header row

[AnitaPita]

Hi,

I have the following macro to delete blank columns...how could I alter this to skip the first row (not look at the header)? It thinks the column is not blank because there is a header in the first row, but the remainder of the column might not have any data. I want those deleted...
Thanks!!!



Sub DeleteROPBlanks()
'
' DeleteROPBlanks Macro
Dim Col As Long, ColCnt As Long, Rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo Exits:

If Selection.Columns.Count > 1 Then
Set Rng = Selection
Else
Set Rng = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
End If
ColCnt = 0
For Col = Rng.Columns.Count To 2 Step -1
If Application.WorksheetFunction.CountA(Rng.Columns(Col).EntireColumn) = 0 Then
Rng.Columns(Col).EntireColumn.delete
ColCnt = ColCnt + 1
End If
Next Col

Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Kiwiman]

Howzit

This should work. You will need to chage "Sheet3" to your sheetname

Sub Del_Empty_Cols()

Dim lngLastCol As Long
Dim lnglastRow As Long

Dim i As Integer

' Get the last column populated - this assumes that each column
' has a column header and the column header is on row 1
lngLastCol = Sheets("Sheet3").Cells(1, Columns.Count).End(xlToLeft).Column

' For each column determine if column is empty, and if so delete the column
For i = lngLastCol To 1 Step -1  ' Start loop at last column and work backwards
    lnglastRow = Sheets("Sheet3").Cells(Rows.Count, i).End(xlUp).Row  ' Get the last row of the current column
    If lnglastRow = 1 Then
        ' as only the header row exists, it is safe to delete the column
        Columns(i).Delete   ' Delete column
    Else
        ' do nothing
    End If
Next i

End Sub