Need to improve column delete code

[ouadad]

I wrote a bit of code to compare the sums in three cells and if they are all zero I need to delete the column, but it's achingly slow; like one column every 3 seconds and there are over 5000 columns.

Is there a way to speed up the process?

Code:

Sub Delete_Columns_with_no_demand_or_forecasts()
Dim iRow As Integer, iColumn As Integer, totalcols As Long
For iColumn = 5159 To 2 Step -1
    If Cells(16, iColumn) + Cells(30, iColumn) + Cells(44, iColumn) = 0 Then
        Columns(iColumn).EntireColumn.Delete
    End If
    Cells(1, 1) = iColumn
Next iColumn
End Sub

 

[Fluff]

Try

Sub Delete_Columns_with_no_demand_or_forecasts()
   Dim iRow As Integer, iColumn As Integer, totalcols As Long
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
   For iColumn = 5159 To 2 Step -1
       If Cells(16, iColumn) + Cells(30, iColumn) + Cells(44, iColumn) = 0 Then
           Columns(iColumn).EntireColumn.Delete
       End If
       Cells(1, 1) = iColumn
   Next iColumn
   With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = xlCalculationAutomatic
   End With
End Sub

 

[ouadad]

Thank you.

 

[Fluff]

You're welcome

 

[Akuini]

I wrote a bit of code to compare the sums in three cells and if they are all zero I need to delete the column, but it's achingly slow; like one column every 3 seconds and there are over 5000 columns.

Is there a way to speed up the process?

Another option:
Assuming there are no blank cell in row 1 in the data set.

Sub a1078141a()
'https://www.mrexcel.com/forum/excel-questions/1078141-need-improve-column-delete-code.html
Dim r As Range, i As Long, va, vb
 
 va = Range(Cells(1, 1), Cells(44, 5159))
 Set r = Range(Cells(1, 1), Cells(1, 5159))
 vb = r
    For i = 2 To 5159
           If va(16, i) + va(30, i) + va(44, i) = 0 Then
           vb(1, i) = ""
           End If
    Next
 
 r = vb
 r.SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
 
End Sub