Slow Code

[thewizz]

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

 

[John Bundy]

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

 

[thewizz]

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!

 

[JE McGimpsey]

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

 

[thewizz]

Wow, I just tried the same file agian with your additions and it run in a
about 10 seconds!

Thanks A LOT!

 

[JE McGimpsey]

FWIW, the solution I suggested took about 10 seconds with 30000 rows of
data.

 

[George Nicholson]

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