|
Speed it up?
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 |
Speed it up?
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 |
Speed it up?
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 |
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 |
Speed it up?
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 |
| All times are GMT +1. The time now is 10:15 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com