Applying Autosum multiple times in one column with varying numbers of lines

[Jerry138889]

Hi.

I have a set of data where I have to add in multiple subtotals but I can't use the subtotal function for a couple of reasons.

Basically I have data like this:

10
20
15
10
10
11
11
10
15
20
35
50
15
15
15

<tbody>
</tbody>

And everywhere there is a gap I want to add a subtotal so that it only adds the figures between the two gaps. For example, if I filled out the above example as I would like it, I would get:

10
20
15
45
10
10
11
11
10
52
15
20
35
50
120
15
15
15
15
30

<tbody>
</tbody>

When I manually click "Autosum" when I'm within the blank cells, autosum knows to only sum the cells that have not already been summed. I.e. for the last total which is 30, autosum knows to not sum all the items above - it just sums the last two.

My question is this - how do I use that same logic and apply it to all the blank cells at once instead of clicking autosum about 10,000 times like I did today.

Literally 10,000! I know there must be a way but I spent a solid hour googling and couldn't figure out how to phrase my query so as to find a solution as I'm sure this has been asked before.

Thank you very much.

 

[MickG]

Try this:-

Dim Rng As Range, Dn As Range
Set Rng = Range("A:A").SpecialCells(xlCellTypeConstants)
For Each Dn In Rng.Areas
    Dn(Dn.Count + 1).Value = Application.Sum(Dn)
Next Dn

 

[Jerry138889]

Try this:-

Dim Rng As Range, Dn As Range
Set Rng = Range("A:A").SpecialCells(xlCellTypeConstants)
For Each Dn In Rng.Areas
    Dn(Dn.Count + 1).Value = Application.Sum(Dn)
Next Dn

Mick, you beautiful, beautiful man! Works like a charm!

 

[MickG]

You're welcome

 

[Jerry138889]

You're welcome

Just wanted to say thanks again - this has helped me out no end!

 

[MickG]

Such a small piece of code , such a large response !!
Thank You.