![]() |
Slow Code
I have the following code, which is looking to see if there is data in column
"O" starting with row 5 and ending with the "nRow" which is the last row with data in the column. "nRow" could be as high as the maximum rows in Excel. If there is data greater than "0" it copies varius cells to other cells in another sheet. My question is: Is there a more efficiant way to do this? It takes a long time to run this code when there is a lot of data in "O". Thank you! Sub FillAllData() FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter End Sub -- I am not where I intended to go, but I think I am where I am supposed to be! |
Slow Code
There are more elegant ways for sure, but yours is ok. Adding these 2 lines
to the beginning and end should sppe it up substantially. It holds off displaying the changes and all calculations until you are done, then starts it again. Sub FillAllData() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub -- -John Please rate when your question is answered to help us and others know what is helpful. "thewizz" wrote: I have the following code, which is looking to see if there is data in column "O" starting with row 5 and ending with the "nRow" which is the last row with data in the column. "nRow" could be as high as the maximum rows in Excel. If there is data greater than "0" it copies varius cells to other cells in another sheet. My question is: Is there a more efficiant way to do this? It takes a long time to run this code when there is a lot of data in "O". Thank you! Sub FillAllData() FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter End Sub -- I am not where I intended to go, but I think I am where I am supposed to be! |
Slow Code
Thank you John, I will give those additions a shot and see how it does! I
just ran a file with 30000+ rows of data and it took about 5 minutes to run! -- I am not where I intended to go, but I think I am where I am supposed to be! "John Bundy" wrote: There are more elegant ways for sure, but yours is ok. Adding these 2 lines to the beginning and end should sppe it up substantially. It holds off displaying the changes and all calculations until you are done, then starts it again. Sub FillAllData() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub -- -John Please rate when your question is answered to help us and others know what is helpful. "thewizz" wrote: I have the following code, which is looking to see if there is data in column "O" starting with row 5 and ending with the "nRow" which is the last row with data in the column. "nRow" could be as high as the maximum rows in Excel. If there is data greater than "0" it copies varius cells to other cells in another sheet. My question is: Is there a more efficiant way to do this? It takes a long time to run this code when there is a lot of data in "O". Thank you! Sub FillAllData() FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter End Sub -- I am not where I intended to go, but I think I am where I am supposed to be! |
Slow Code
This should be somewhat more efficient, as long as BSheets!O4 is not
blank: Public Sub FillAllData() Const AllSheet As String = "Sheet7" Const BSheets As String = "Sheet8" Const nStartRow As Long = 5 Dim rSource As Range Dim rDest As Range Set rDest = Sheets(AllSheet).Range("A3") With Sheets(BSheets) .Range(.Cells(nStartRow - 1, "O"), .Cells(.Rows.Count, _ "T")).AutoFilter Field:=1, Criteria1:="0" On Error Resume Next .Range(.Cells(nStartRow, "O"), .Cells(.Rows.Count, _ "P")).SpecialCells(xlCellTypeVisible).Copy _ Destination:=rDest .Range(.Cells(nStartRow, "Q"), .Cells(.Rows.Count, _ "T")).SpecialCells(xlCellTypeVisible).Copy _ Destination:=rDest.Offset(0, 3) On Error GoTo 0 .Cells(4, "O").AutoFilter End With End Sub In article , thewizz wrote: I have the following code, which is looking to see if there is data in column "O" starting with row 5 and ending with the "nRow" which is the last row with data in the column. "nRow" could be as high as the maximum rows in Excel. If there is data greater than "0" it copies varius cells to other cells in another sheet. My question is: Is there a more efficiant way to do this? It takes a long time to run this code when there is a lot of data in "O". Thank you! Sub FillAllData() FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter End Sub |
Slow Code
Wow, I just tried the same file agian with your additions and it run in a
about 10 seconds! Thanks A LOT! -- I am not where I intended to go, but I think I am where I am supposed to be! "John Bundy" wrote: There are more elegant ways for sure, but yours is ok. Adding these 2 lines to the beginning and end should sppe it up substantially. It holds off displaying the changes and all calculations until you are done, then starts it again. Sub FillAllData() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub -- -John Please rate when your question is answered to help us and others know what is helpful. "thewizz" wrote: I have the following code, which is looking to see if there is data in column "O" starting with row 5 and ending with the "nRow" which is the last row with data in the column. "nRow" could be as high as the maximum rows in Excel. If there is data greater than "0" it copies varius cells to other cells in another sheet. My question is: Is there a more efficiant way to do this? It takes a long time to run this code when there is a lot of data in "O". Thank you! Sub FillAllData() FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter End Sub -- I am not where I intended to go, but I think I am where I am supposed to be! |
Slow Code
FWIW, the solution I suggested took about 10 seconds with 30000 rows of
data. In article , thewizz wrote: Thank you John, I will give those additions a shot and see how it does! I just ran a file with 30000+ rows of data and it took about 5 minutes to run! |
Slow Code
Here's one approach. In general, every calculation, evaluation or dot that
you can place outside of a loop, the better. For example, setting an object reference to rngTarget and rngSource before you enter the loop means that "Sheets(AllSheet).Range(yada, yada)" won't need to be re-evaluated thousands of times (and since .Value is the default property for a Range, you should be safe in excluding it, saving empteen evaluations). Similarly, I've found that Offset(row,column) works very efficiently for the type of thing you are doing: set one range reference and use it as an anchor/reference point for Offset, rather than endless Range(r,c) determinations. Sub FillAllData() Dim iReadRow as Long Dim iFillRow as Long Dim rngSource as Range Dim rngTarget as Range Set rngTarget = Sheets(BSheets).Range("A3") Set rngSource = Sheets(AllSheet).Range("O5") iFillRow = 0 For iReadRow = 0 to nRow - 5 'Same as 5 to nRow now If rngSource.Offset(iReadRow,0) 0 Then With rngTarget .Offset(iFillRow,0) = rngSource.Offset(iReadRow,0) 'O to A .Offset(iFillRow,1) = rngSource.Offset(iReadRow,1) 'P to B .Offset(iFillRow,3) = rngSource.Offset(iReadRow,2) 'Q to *D* .Offset(iFillRow,4) = rngSource.Offset(iReadRow,3) 'R to E .Offset(iFillRow,5) = rngSource.Offset(iReadRow,4) 'S to F .Offset(iFillRow,6) = rngSource.Offset(iReadRow,5) 'T to G End With iFillRow = iFillRow + 1 End If Next iRow Set rngSource = Nothing Set rngTarget = Nothing End Sub -- HTH, George "thewizz" wrote in message ... I have the following code, which is looking to see if there is data in column "O" starting with row 5 and ending with the "nRow" which is the last row with data in the column. "nRow" could be as high as the maximum rows in Excel. If there is data greater than "0" it copies varius cells to other cells in another sheet. My question is: Is there a more efficiant way to do this? It takes a long time to run this code when there is a lot of data in "O". Thank you! Sub FillAllData() FillCount = 3 For counter = 5 To nRow CellValue = Sheets(BSheets).Range("O" & counter).Value If CellValue 0 Then Sheets(AllSheet).Range("A" & FillCount).Value = Sheets(BSheets).Range("O" & counter).Value Sheets(AllSheet).Range("B" & FillCount).Value = Sheets(BSheets).Range("P" & counter).Value Sheets(AllSheet).Range("D" & FillCount).Value = Sheets(BSheets).Range("Q" & counter).Value Sheets(AllSheet).Range("E" & FillCount).Value = Sheets(BSheets).Range("R" & counter).Value Sheets(AllSheet).Range("F" & FillCount).Value = Sheets(BSheets).Range("S" & counter).Value Sheets(AllSheet).Range("G" & FillCount) = Sheets(BSheets).Range("T" & counter).Value FillCount = FillCount + 1 End If Next counter End Sub -- I am not where I intended to go, but I think I am where I am supposed to be! |
All times are GMT +1. The time now is 08:07 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com