Delete Entire Column if column only consists of zeros and blank values - excel

Question

I was wondering if someone could help me with this excel VBA challenge i faced,
I am trying to delete a column if a column has only 0 and blank values, the format looks like the below picture:
As i have highlighted the two columns has only zero and blank values and those 2 columns should be deleted.
Excel Column Format
I have tried this code but unfortunately it deletes all the columns:
Sub dynamicRange()
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim startCell As Range, lastRow As Long, lastCol As Long, ws As Worksheet
Set ws = ActiveSheet
Set startCell = Range("E9")
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, ws.Columns.Count).End(xlToLeft).Column
ws.Range(startCell, ws.Cells(lastRow, lastCol)).Select
Set a = Selection
For Each cell In a
If cell.Value = "Total" Or cell.Value = "Tag" Or cell.Value = "Delivery Fee" Or cell.Value = "CC/Cash" Or cell.Value = "Postcode" Then
cell.EntireColumn.Delete
End If
Next cell
For Each cell In a
If cell.Value = 0 Or cell.Value = "" Then
cell.EntireColumn.Delete
End If
Next cell
Application.Calculation = xlCalculationManual
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Looking forward for a solution, Thank you.

Answer 1

you can use count number of populated cells in range
WorksheetFunction.CountA(range)
This is sample code
sub test()
dim lasCol as integer
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
for i = lastCol to 1 Step - 1
if worksheetfunction.countA(Columns(i)) = 0 then
Columns(i).delete
end if
next i
end sub
Of course you can change Column to Range to check it content data or not that fit your file. eg
if worksheetfunction.countA(range("A2:A10, A15:A20")) = 0 then
Or
if worksheetfunction.countA(range(cells(2,i), cells(10,i))) + worksheetfunction.countA(range(cells(15,i), cells(20,i)))= 0 then

Answer 2

If you want to delete columns without value you can use Excel's own SUM() function with simple code as shown below.
Sub DynamicRange()
Dim startCell As Range
Dim SumRng As Range
Dim lastRow As Long, lastCol As Long
Dim C As Long
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
Set startCell = .Range("E9")
lastRow = .Cells(.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = .Cells(startCell.Row, .Columns.Count).End(xlToLeft).Column
For C = lastCol To startCell.Column Step -1
Set SumRng = .Range(.Cells(startCell.Row, C), .Cells(lastRow, C))
If Application.Sum(SumRng) = 0 Then .Columns(C).Delete
Next C
End With
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
I'm not sure I understand the significance of your startCell at E9 correctly. Your code doesn't appear to match with the picture of your worksheet in that respect. My code ignores values which are above row 9 but that would be very easy to modify. Just let me know. The point is that using the SUM() function makes the code run much faster than having to examine every cell.

Answer 3

Delete Zero-Blank Columns
Option Explicit
Sub DeleteEmptyColumns()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim rng As Range, URng As Range, startCell As Range
Dim lastRow As Long, lastCol As Long, ws As Worksheet
Dim j As Long ' Column Counter
Dim i As Long ' Row Counter
On Error GoTo ProgramError
Set ws = ActiveSheet
Set startCell = ws.Range("E9")
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, ws.Columns.Count).End(xlToLeft).Column
For j = startCell.Column To lastCol
For i = startCell.Row To lastRow
Set rng = ws.Cells(i, j)
If rng.Value <> 0 And rng.Value <> "" Then Exit For
Next
If i > lastRow Then Set rng = ws.Cells(1, j): GoSub UnionRange
Next
' ' While developing such a code, use Hidden instead of Delete.
' If Not URng Is Nothing Then URng.EntireColumn.Hidden = True
If Not URng Is Nothing Then URng.EntireColumn.Delete
MsgBox "Operation finished successfully."
SafeExit:
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
Exit Sub
UnionRange:
If Not URng Is Nothing Then
Set URng = Union(URng, rng)
Else
Set URng = rng
End If
Return
ProgramError:
MsgBox "An unexpected error occurred."
On Error GoTo 0
GoTo SafeExit
End Sub