Try this...

Public Sub RemoveZeros()
Application.Calculation = xlCalculationManual
Call ReplaceZeros("P")
Call ReplaceZeros("Q")
Call ReplaceZeros("U")
Call ReplaceZeros("V")
Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub ReplaceZeros(ByVal sColumn As String)
Dim rng As Range
With Sheets("Sheet1")
Set rng = .Range(.Cells(8, sColumn), .Cells(Rows.Count, sColumn))
End With

rng.Replace What:=0, _
Replacement:="", _
LookAt:=xlWhole
End Sub

--
HTH...

Jim Thomlinson


"Ray" wrote:

Hi -

I'm using the code below to remove zero values from a range of
cells ... actually, four ranges of cells. The ranges will be the same
within a workbook, but will differ between workbooks -- so, today's
range could be Row 8 to Row 52, but tomorrow could be Row 8 to Row 61
(ALWAYS starts with Row 8).

For what it's doing, I think the current code is taking WAY too long
to run -- some users report upto 3-4 minutes. All users are using
XL02 on XP ...

Is there anyway to change the code so that it runs faster?

Thanks, Ray

Current Code:
Application.StatusBar = "Removing un-necessary zeroes ..."
ActiveSheet.Range("P8").Activate
Do While IsEmpty(ActiveCell.Value) = False
If ActiveCell.Value = 0 Then
ActiveCell.ClearContents
ActiveCell.Offset(1, 0).Activate
Loop

ActiveSheet.Range("Q8").Activate
Do While IsEmpty(ActiveCell.Value) = False
If ActiveCell.Value = 0 Then
ActiveCell.ClearContents
ActiveCell.Offset(1, 0).Activate
Loop

ActiveSheet.Range("U8").Activate
Do While IsEmpty(ActiveCell.Value) = False
If ActiveCell.Value = 0 Then
ActiveCell.ClearContents
ActiveCell.Offset(1, 0).Activate
Loop

ActiveSheet.Range("V8").Activate
Do While IsEmpty(ActiveCell.Value) = False
If ActiveCell.Value = 0 Then
ActiveCell.ClearContents
ActiveCell.Offset(1, 0).Activate
Loop