VBA code to delete formula if result = zero

[asyouread]

I'm trying to reduce an Excel 2010 file in size by clearing the contents of cells where a formula has returned a zero value. I have found this VBA script which does the job but not very well for the data set I'm working with:

Sub delzero()
For Each Cell In [W12:BF24459]
If Cell.Value = "0" Then Cell.ClearContents
Next Cell
End Sub

It will work for one column e.g.[W12:W24459], although very slowly but I need to do the whole data set [W12:BF24459}.

Does anyone have some VBA code to do this quickly and without crashing the file?

Thanks in advance

 

[Trevor_S]

I've tried it on a blank sheet, and it ran in seconds - so the delay is not because of the number of cells being processed.

Have you tried turning recalculation off before running it? Otherwise every time that the macro is blanking a cell, it will be recalculating the entire workbook - which will slow it down.

Another thought is to turn off screen updating while its running - to do this add: Application.ScreenUpdating = False before the For... line, and Application.ScreenUpdating = True after the Next... line.

 

[Dryver14]

try this, see if it works any faster


Sub DelZero()

Range("W12:BF24459").Select
Cells.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

 

[asyouread]

Dryver14, that code deleted all of the zeros, not just those in the range. I'm not sure why it would look outside of the range specified?

 

[asyouread]

Thanks Trevor_S, I added the Application.ScreenUpdating lines but it hasn't made much of a difference to the running speed (or stability).

Perhaps the issue is with the size of the formula and the number of cells it's running on...here is the formula which is phasing sales revenue based on contract dates: =IF(AND($H12<=W$2,$I12>=W$2),($L12/($I12-$H12+1)*(W$2-$H12+1))-SUM(V12:$V12),IF($I12<=W$2,$L12-SUM($V12:V12),0)). This formula is located in 23,326 rows across 36 columns (being the monthly time series).

Any suggestions?

Thanks

 

[Peter_SSs]

I'm not sure why it would look outside of the range specified?

Because of ..

Sub DelZero()

Range("W12:BF24459").Select
Cells.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

.. but I don't think that will solve your problem anyway because your zeros are the results of formulas.

 

[Peter_SSs]

Not sure how it will go for speed with your large range and formulas, but you could try this in a copy of your workbook.

Sub DelZeros()
  Dim f, v
  Dim i As Long, j As Long
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  With Range("W12:BF24459")
    f = .Formula
    v = .Value
    For i = 1 To UBound(v, 1)
      For j = 1 To UBound(v, 2)
        If v(i, j) = 0 Then
          If Left(f(i, j), 1) = "=" Then
            f(i, j) = vbNullString
          End If
        End If
      Next j
    Next i
    .Value = f
  End With
  Application.Calculation = xlAutomatic
  Application.ScreenUpdating = True
End Sub

 

[Noodleski]

Stupid suggestion, but what the heck:

do you still need the formulae once they have been calculated? In other words: do you change values in the sheet once the zeroes are gone to update formula output?
If not, you might as well throw out all formulae and for an update, simply start from a base-file which has all the formulae intact.

But as I said: I don't know how you intend to work with it.

 

[Peter_SSs]

Stupid suggestion, but what the heck:

Not stupid at all to me. Good question.

 

[asyouread]

Yes I still need the formula as I it is a forecast model with variable inputs. The intention is to re-calculate and copy formulae across the entire series if variables are changed. I have another macro that makes this process fairly quick.