How to make a simple "Sum" loop faster? - excel

Question

I am beginning to learn how to use loops and arrays but this one has me stuck. Below is a code that loops through cells and adds them together in column P.
Sub Loop_Test()
Dim sht1 As Worksheet
Dim lr As Long
Dim i As Long
Set sht1 = Worksheets("Sheet1")
lr = Fcst.Cells(Rows.Count, "A").End(xlUp).Row
With sht1
For i = 4 To lr
.Range("P" & i).Value = Application.Sum(Range("D" & i, "O" & i))
Next
End With
End Sub
Overall, this code works but it is very slow and I need to apply it to thousands of rows. I know that in order to make this faster, I need to turn the sum range into an array but I am not entirely sure how to do this when a loop is included.
Any help would be greatly appreciated.
Thanks,
G
Disclaimer: I know there are more efficient ways to sum cells together but this is just me playing around and learning.

Answer 1

Just do them all at once. Looping only adds time to process individual iterations.
With sht1.Range(sht1.cells(4, "P"), sht1.cells(lr, "P"))
.formula = "=sum(D4:O4)"
.Value = .value
End With

Answer 2

Use a variant array to limit the number of times that the vba accesses the worksheets:
Sub Loop_Test()
Dim sht1 As Worksheet
Set sht1 = Worksheets("Sheet1")
Dim fcst As Worksheet
Set fcst = Worksheets("Sheet2")
Dim lr As Long
lr = fcst.Cells(Rows.Count, "A").End(xlUp).Row
Dim dta As Variant
dta = fcst.Range(fcst.Cells(4, "D"), fcst.Cells(lr, "O")).Value
Dim otpt As Variant
ReDim otpt(1 To UBound(dta, 1), 1 To 1)
With sht1
Dim i As Long
For i = LBound(dta, 1) To UBound(dta, 1)
otpt(i, 1) = Application.Sum(Application.Index(dta, i, 0))
Next i
.Range("P4").Resize(UBound(dta, 1), 1).Value = otpt
End With
End Sub
Edit
The SUM(INDEX()) is slow it is quicker just to add the parts individually.
Sub Loop_Test()
Dim sht1 As Worksheet
Set sht1 = Worksheets("Sheet1")
Dim fcst As Worksheet
Set fcst = Worksheets("Sheet2")
Dim lr As Long
lr = fcst.Cells(Rows.Count, "A").End(xlUp).Row
Dim dta As Variant
dta = fcst.Range(fcst.Cells(4, "D"), fcst.Cells(lr, "O")).Value
Dim otpt As Variant
ReDim otpt(1 To UBound(dta, 1), 1 To 1)
With sht1
Dim i As Long
For i = LBound(dta, 1) To UBound(dta, 1)
Dim j as Long
For j = lbound(dta,2) to ubound(dta,2)
otpt(i, 1) = otpt(i, 1) + dta(i, j)
Next j
Next i
.Range("P4").Resize(UBound(dta, 1), 1).Value = otpt
End With
End Sub
Tested on 50,000 rows and result was near instantaneous.

Answer 3

Rather than looping over each row you can insert a summation formula into each row of column P with a single line of code:
.Range("P4:P" & lr).Formula="=SUM(D4:O4)"
assuming 4 is the starting row, and your variable lr is the last row.

Answer 4

Faster With an Array
Sub Loop_Test()
Const cSheet1 As Variant = "Sheet1"
Const cSheet2 As Variant = "Sheet2"
Const fr As Integer = 4
Dim sht1 As Worksheet
Dim fcst As Worksheet
Dim lr As Long
Dim i As Long
Dim vnt As Variant
Set sht1 = Worksheets(cSheet1)
Set fcst = Worksheets(cSheet2)
With fcst
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim vnt(1 To lr - fr + 1, 1 To 1)
For i = 1 To UBound(vnt)
vnt(i, 1) = WorksheetFunction.Sum( _
.Range("D" & i + fr - 1, "O" & i + fr - 1))
Next
End With
sht1.Cells(fr, "P").Resize(UBound(vnt)) = vnt
End Sub