Delete Blank or Empty Columns Use Excel VBA Less Headers

[bepedicino]

I have the following VBA code that will delete columns that are entirely blank. I would like to modify the code so that if a range below the first three rows (headers) is blank, then the entire column will be deleted. Can anyone assist please?

Sub DeleteBlankColumns()'Step1:  Declare your variables.
    Dim MyRange As Range
    Dim iCounter As Long
'Step 2:  Define the target Range.
    Set MyRange = ActiveSheet.UsedRange
    
'Step 3:  Start reverse looping through the range.
    For iCounter = MyRange.Columns.Count To 1 Step -1
    
'Step 4: If entire column is empty then delete it.
       If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
       Columns(iCounter).Delete
       End If
'Step 5: Increment the counter down
    Next iCounter

End Sub

 

[Fluff]

How about

Sub DeleteBlankColumns() 'Step1:  Declare your variables.
    Dim MyRange As Range
    Dim iCounter As Long
'Step 2:  Define the target Range.
    Set MyRange = ActiveSheet.UsedRange
    
'Step 3:  Start reverse looping through the range.
    For iCounter = MyRange.Columns.Count To 1 Step -1
    
'Step 4: If entire column is empty then delete it.
      If Application.CountA(Intersect(MyRange.Offset(3), Columns(iCounter))) = 0 Then
       Columns(iCounter).Delete
       End If
'Step 5: Increment the counter down
    Next iCounter

End Sub

 

[bepedicino]

Unfortunately it did not work. To further illustrate columns 2,4,6 and 8 should be completed deleted in the example below.

When I tried the code that you provided nothing happened; when I switch the offset to 4 all columns get deleted.

______|Col 1___|Col 2___|Col 3____|Col 4___|Col 5___|Col 6_____|Col 7___|Col 8___|
Row 1 |Header|
Row 2 |Header|
Row 3 |Header|_|Header|_|Header|_|Header|_|Header|_|Header|__|Header__|blank__|
Row 4 |Data|___|blank|__|Data|____|blank|__|Data|___|blank____|Data____|blank___|
Row 5 |Data|___|blank|__|Data|____|blank|__|Data|___|blank____|Data____|blank___|
Row 6 |Data|___|blank|__|Data|____|blank|__|Data|___|blank____|blank___|blank___|
Row 7 |Data|___|blank|__|Data|____|blank|__|Data|___|blank____|Data____|blank___|
Row 8 |Data|___|blank|__|Data|____|blank|__|Data|___|blank____|blank____|blank___|

How about

Sub DeleteBlankColumns() 'Step1:  Declare your variables.
    Dim MyRange As Range
    Dim iCounter As Long
'Step 2:  Define the target Range.
    Set MyRange = ActiveSheet.UsedRange
    
'Step 3:  Start reverse looping through the range.
    For iCounter = MyRange.Columns.Count To 1 Step -1
    
'Step 4: If entire column is empty then delete it.
      If Application.CountA(Intersect(MyRange.Offset(3), Columns(iCounter))) = 0 Then
       Columns(iCounter).Delete
       End If
'Step 5: Increment the counter down
    Next iCounter

End Sub

 

[Fluff]

Do you have any merged cells?

 

[bepedicino]

Yes, in cell C1:D1 and C2:D2; however, columns will only need to be deleted in the column E through O range.

Thank you for all your support.

Do you have any merged cells?

 

[Fluff]

Try stepping through the code using F8.
If you have the VBE open on one half of the screen, you can see what is going-on on the sheet.
does each column get deleted individually?

 

[bepedicino]

Correction, your VBA works like a charm! Thank you!

I've realized that the blank cells are not truly blank, they contained formula, therefore they are not being deleted. I must retain the formatting of the cells so I am not sure what the next step would be here.

Yes, in cell C1:D1 and C2:D2; however, columns will only need to be deleted in the column E through O range.

Thank you for all your support.

 

[Fluff]

Are the formulae returning numbers, text or both?

 

[bepedicino]

Problem Solved, thank you Fluff !!!!

I needed to add some additional VBA to clear out the blank cell and all is good.

Again thanks to you, and the Mr. Excel community for the continued support.

Are the formulae returning numbers, text or both?

 

[Fluff]

Glad to help & thanks for the feedback