Create Loop to Sum 5 cells, Enter Value in 5th Cell

[mkeys4]

I unfortunately know almost nothing about VBA, so I'm really depending on you guys for help.

I'm trying to write a code that, in a new column(AN), a) sums 5 cells in another column(AM), b)re-starts the loop at the end of 5 cells, c)uses the 5th cell as the 1st value in the next loop and d)enters the sum in the 5th cell of column (AN). To be clear, I'd like the sum of AM4:AM8 to be populated in AN8, and so on, with the next sum to pull AM8 as its first value. There are also FALSE statements in column (AM) A standard sum offset will populate straight down instead of offsetting again, so I need a vba code.


I've attached the workbook. The values I want summed are in AM, and I'd like the sums to be in column AN.

I don't know if this is possible or hard, but I would be so unbelievable appreciative of help!

[Ken Puls]

Hi there,

Give this a go and see if it does what you want. Copy the code into a standard module first. There is a link in my signature as to where to put it.

Sub SUM_every_fifth()

    Dim lSum As Double
    Dim lLast As Double
    Dim j As Long
    
    Do Until Selection.Value = vbNullString
        lSum = lLast
        For j = 1 To 5
            lSum = lSum + Selection.Value
            Selection.Offset(1, 0).Select
        Next j
        Selection.Offset(-1, 1).Value = lSum
        lLast = Selection.Offset(-1, 0).Value
    Loop
End Sub

Once you have it in there, select the first cell in the column of data, and run it.

Not the prettiest code, but hopefully it does what you're after.

[JoePublic]

Please also have a read of this: http://www.excelguru.ca/content.php?184
and update your post to add links to all your cross-posts in other forums.
Thanks.

[mkeys4]

Here's the code that worked:

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

[mkeys4]

How do I mark this as solved?

[Ken Puls]

We don't mark threads as solved here, (one day I'll get around to adding that). Thanks for posting your solution back though, I appreciate it.