Speed it up?

[Ray]

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

 

[Jim Thomlinson]

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

 

[Ray]

Jim -

That worked great ... sped things up noticeably, but still a bit
slower than I think it should be ... could it be the other part of the
macro that slowing things down? The code for this is:
ActiveSheet.Range("AA8").Activate
Do While IsEmpty(ActiveCell.Value) = False
If ActiveCell.Value = "yes" Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.ClearContents
ActiveCell.Offset(1, 0).Activate
End If
Loop

The main data-table is approx 250 lines, but not all rows are
necessary every day ... the code above loops through all of the lines,
deleting those that aren't necessary. Can this be simplified as well?

TIA,
ray

 

[Jim Thomlinson]

Try this...

Public Sub DeleteYes()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirst As String

With Sheets("Sheet1")
Set rngToSearch = .Range(.Range("AA8"), .Cells(Rows.Count, "AA"))
End With

Set rngFound = rngToSearch.Find(What:="Yes", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not rngFound Is Nothing Then
Set rngFoundAll = rngFound
strFirst = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirst
rngFoundAll.EntireRow.Delete
End If
End Sub

 

[Ray]

Again, perfect! MUCH faster than it was ....

Thanks alot Jim!