Here's the code that worked:
Code:
Sub Summate2():
Worksheets("Calc").Activate
Dim S As Double, r As Long, lr As Long, i As Integer
lr = Worksheets("Calc").Range("CH" & Rows.Count).End(xlUp).Row
For r = 4 To lr:
For i = 0 To 4
If IsNumeric(Worksheets("Calc").Range("CH" & r + i).Value2) Then S = S + Worksheets("Calc").Range("CH" & r + i).Value2
Next i: r = r + i - 1
If r > lr Then GoTo EndSub
Worksheets("Calc").Range("CI" & r) = S: S = 0
Next r
EndSub: Worksheets("Calc").Range("CI" & lr) = S: End Sub
Bookmarks