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

  • Hi All,

    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.



    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.

  • Try this:


    change the sheet number to suit.


    Justin