Sum Multiple Ranges

[FIRSTROUNDKO via OfficeKB.com]

HI,

I have a 1 collumn which I have seperated in to ranges, of various lengths,
with 4 empty cells below each range I am trying to loop through and sum each
range on the 3rd cell below each range.

Thanks in Advance

Darren

 

[Guest]

Here's one way (you have to select the whole column, excluding any headings
and down to the third cell below the final number group):

Sub mySum()
Dim myCounter As Long
Dim myTotal As Double
myTotal = 0
myCounter = 0
Do While myCounter <= Selection.Rows.Count
If ActiveCell.Offset(myCounter, 0).Value <> "" Then
myTotal = myTotal + ActiveCell.Offset(myCounter, 0).Value
Else
ActiveCell.Offset(myCounter + 2, 0).Value = myTotal
myTotal = 0
myCounter = myCounter + 3
End If
myCounter = myCounter + 1
Loop
End Sub

 

[Mike Fogleman]

Name your ranges rng1, rng 2 rng3, etc then use the following code:

Sub SumRngs()
Dim RngRows As Long
Dim c As String
Dim rngsum As Range
Dim cntr As Long

For cntr = 1 To 3
RngRows = Range("rng" & cntr).Rows.Count
c = Range("rng" & cntr).Address
Range(c).Range("A1").Offset(RngRows + 2, 0).Value =
WorksheetFunction.Sum(Range("rng" & cntr))
Next cntr
End Sub

MIke F