Sum Cell Values Until Blank Cells With VBA

[blueman0110]

Hello,
I found this code on the internet. How do I get the sum value to appear in the empty cell above the cells containing consecutive values. I'm thinking of running the code from the last row. Thank for your help :D

How to sum cell values in a column until blank cell reached?

Sub InsertTotals()
'Updateby Extendoffice
Dim xRg As Range
Dim i, j, StartRow, StartCol As Integer
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.AddressLocal
Set xRg = Application.InputBox("please select the cells:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
StartRow = xRg.Row
StartCol = xRg.Column
For i = StartCol To xRg.Columns.Count + StartCol - 1
For j = xRg.Row To xRg.Rows.Count + StartRow - 1
If Cells(j, i) = "" Then
Cells(j, i).Formula = "=SUM(" & Cells(StartRow, i).Address & ":" & Cells(j - 1, i).Address & ")"
StartRow = j + 1
End If
Next
StartRow = xRg.Row
Next
End Sub

 

[blueman0110]

Assuming that the numbers to be added are not the results of formulas and are on the active sheet (code can be adjusted if either is not the case)

Sub Insert_Totals()
  Dim rA As Range
 
  For Each rA In Columns("A").SpecialCells(xlConstants, xlNumbers).Areas
    rA.Cells(0).Formula = "=SUM(" & rA.Address & ")"
  Next rA
End Sub

My sample data before the code:

blueman0110.xlsm
	A
1
2	3
3	1
4	9
5
6	5
7	7
8	2
9
10	2
11
12	6
13	6
14	2
15
16	4
17	3
18	9
19	8
20	7
Sheet1

.. and after:

blueman0110.xlsm
	A
1	13
2	3
3	1
4	9
5	14
6	5
7	7
8	2
9	2
10	2
11	14
12	6
13	6
14	2
15	31
16	4
17	3
18	9
19	8
20	7
Sheet1

Cell Formulas
Range	Formula
A1	A1	=SUM($A$2:$A$4)
A5	A5	=SUM($A$6:$A$8)
A9	A9	=SUM($A$10)
A11	A11	=SUM($A$12:$A$14)
A15	A15	=SUM($A$16:$A$20)

Thank you, Peter. It works perfectly. Can you guide me how to edit if the starting position is not A1?.

 

[Peter_SSs]

Can you guide me how to edit if the starting position is not A1?.

Try something like this

Sub Insert_Totals_v2()
  Dim rA As Range
  
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlNumbers).Areas
    rA.Cells(0).Formula = "=SUM(" & rA.Address & ")"
  Next rA
End Sub

In the sheet below, the green cells were empty before the code was run.

blueman0110.xlsm
	C
1
2	13
3	3
4	1
5	9
6	14
7	5
8	7
9	2
10	2
11	2
12	14
13	6
14	6
15	2
16	31
17	4
18	3
19	9
20	8
21	7
Sheet1

Cell Formulas
Range	Formula
C2	C2	=SUM($C$3:$C$5)
C6	C6	=SUM($C$7:$C$9)
C10	C10	=SUM($C$11)
C12	C12	=SUM($C$13:$C$15)
C16	C16	=SUM($C$17:$C$21)

 

[blueman0110]

Try something like this

Sub Insert_Totals_v2()
  Dim rA As Range
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlNumbers).Areas
    rA.Cells(0).Formula = "=SUM(" & rA.Address & ")"
  Next rA
End Sub

In the sheet below, the green cells were empty before the code was run.

blueman0110.xlsm
	C
1
2	13
3	3
4	1
5	9
6	14
7	5
8	7
9	2
10	2
11	2
12	14
13	6
14	6
15	2
16	31
17	4
18	3
19	9
20	8
21	7
Sheet1

Cell Formulas
Range	Formula
C2	C2	=SUM($C$3:$C$5)
C6	C6	=SUM($C$7:$C$9)
C10	C10	=SUM($C$11)
C12	C12	=SUM($C$13:$C$15)
C16	C16	=SUM($C$17:$C$21)

Great. I don't know what to say to thank you. I have been researching how to do it for more than 1 month. You have taught me a lesson in rudimentary thinking.

 

[Peter_SSs]

You're welcome. Glad to help.