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

 

[asyouread]

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

Peter, thanks this code works much faster!

 

[Peter_SSs]

Peter, thanks this code works much faster!

Glad it helped. Thanks for letting us know.

 

[Peter_SSs]

BTW, If that whole range "W12:BF24459" consists of formulas then you could omit these lines and it should a bit faster again.

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
          <del>If Left(f(i, j), 1) = "=" Then</del>
            f(i, j) = vbNullString
          <del>End If</del>
        End If
      Next j
    Next i
    .Value = f
  End With
  Application.Calculation = xlAutomatic
  Application.ScreenUpdating = True
End Sub

 

[tsonko]

Hi, try the below. Just adjust Rng to your sheet and starting range.

Dim Rng As Range, i As Long, j As Long, rowArr As Long, clArr As Long

Set Rng = Worksheets("Sheet1").Range("A1")


Dim arr() As Variant


rowArr = Rng.End(xlDown).Row
clArr = Rng.End(xlToRight).Column
    
arr = Range(Rng, Rng.Offset(rowArr - 1, clArr - 1))
    
        For i = 1 To rowArr
            For j = 1 To clArr
        
                If arr(i, j) = 0 Then
                    arr(i, j) = ""
                End If
        
            Next j
            j = 0
        Next i
    
Range(Rng, Rng.Offset(rowArr - 1, clArr - 1)) = arr()




End Sub

 

[Peter_SSs]

Hi, try the below. Just adjust Rng to your sheet and starting range.

Not sure if you noticed post #8 and the OPs response in post #10, but that indicated that formulas, apart from those resulting in 0, should be retained. Your code removes all formulas from the range.