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

Thanks alot Jim!



On Jul 31, 11:11*am, Jim Thomlinson <James_Thomlin...@owfg-Re-Move-
This-.com wrote:
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
--
HTH...

Jim Thomlinson

"Ray" wrote:
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

On Jul 31, 10:29 am, Jim Thomlinson <James_Thomlin...@owfg-Re-Move-
This-.com wrote:
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