Thread: Speed it up?
View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson Jim Thomlinson is offline
external usenet poster
 
Posts: 5,939
Default Speed it up?

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