VBA: Delete Column if Only Header

[SteveOranjin]

Hi,

I have this great macro that removes all columns that ONLY contain a header. However, it doesn't seem to be working anymore. Sometimes also, it doesn't remove all of the columns that I thought it would.

I also have a macro set up that looks for empty cells and clears them if they are blank, but maybe thats not working.

But anyway, can someone take a look at this macro and tell me why it isn't removing columns that only contain headers?

Sub Delete_Row_If_Only_Header()    Dim col As Long
    Application.ScreenUpdating = False
    For col = 42 To 1 Step -1
        If Application.CountA(Columns(col)) = 1 Then Columns(col).Delete
    Next col
    Application.ScreenUpdating = True
End Sub

 

[Scott T]

When you look in a column that should have been deleted but was not what if any thing is in the column? If you go to the last row in the column and do Ctrl + up arrow does it jump to the header?

 

[louisH]

It throws an error. It says "Type Mismatch".

Stange. It works for me. The macro counts the amount of cells that have more that 1 character in them. So if you have any "" value returned from a formula it won't count them.

 

[SteveOranjin]

LouiseH

Is there a way I can have "" counted as a null value, or is there a way for me to remove "" altogether?

Hope you are well,

Steve

 

[louisH]

LouiseH

Is there a way I can have "" counted as a null value, or is there a way for me to remove "" altogether?

Hope you are well,

Steve

Are you still looking for that macro or are you talking about Something else ?
I sent you this code which worked for me, it doesn't count the "" values :

Sub Delete_Row_If_Only_Header()

    Dim col As Long
    Application.ScreenUpdating = False
    For col = Columns.Count To 1 Step -1
        lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, col).End(xlUp).Row
        If Evaluate("SUMPRODUCT((LEN(" & Range(Cells(1, col), Cells(lr, col)).Address & ") > 0)*1)") = 1 Then Columns(col).Delete
    Next col
    Application.ScreenUpdating = True
    
End Sub