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

 

[Zot]

Try this. data in Column A

Sub Test()

Dim cell As Range, rngSum As Range, rngData As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set rngData = ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    If cell = "" Then
        Set rngSum = ws.Range(cell.Offset(1), cell.Offset(1).End(xlDown))
        cell = "=SUM(" & rngSum.Address(0, 0) & ")"
    End If
Next

End Sub

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Sum Cell Values Until Blank Cells With VBA - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[blueman0110]

Try this. data in Column A

Sub Test()

Dim cell As Range, rngSum As Range, rngData As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set rngData = ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    If cell = "" Then
        Set rngSum = ws.Range(cell.Offset(1), cell.Offset(1).End(xlDown))
        cell = "=SUM(" & rngSum.Address(0, 0) & ")"
    End If
Next

End Sub

Thank you. The code works perfectly, there is a special case for a single cell. The code will ignore that cell.

 

[Zot]

Do you mean something like this?

Sub Test()

Dim cell As Range, rngSum As Range, rngData As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set rngData = ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    If cell = "" And Not cell.Offset(2) = "" Then
        Set rngSum = ws.Range(cell.Offset(1), cell.Offset(1).End(xlDown))
        cell = "=SUM(" & rngSum.Address(0, 0) & ")"
    End If
Next

End Sub

 

[blueman0110]

Do you mean something like this?

Sub Test()

Dim cell As Range, rngSum As Range, rngData As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set rngData = ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    If cell = "" And Not cell.Offset(2) = "" Then
        Set rngSum = ws.Range(cell.Offset(1), cell.Offset(1).End(xlDown))
        cell = "=SUM(" & rngSum.Address(0, 0) & ")"
    End If
Next

End Sub

Thanks zot. Not the best but you have helped me a lot. Thank you

 

[blueman0110]

Do you mean something like this?

Sub Test()

Dim cell As Range, rngSum As Range, rngData As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set rngData = ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    If cell = "" And Not cell.Offset(2) = "" Then
        Set rngSum = ws.Range(cell.Offset(1), cell.Offset(1).End(xlDown))
        cell = "=SUM(" & rngSum.Address(0, 0) & ")"
    End If
Next

End Sub

Hello Zot, I try to think about it. The offset function crashes with single cells. Can you help me?

 

[blueman0110]

Cell A3 should be sum(A4:A4)

 

[bebo021999]

If your sheet is sheet1; column A starts from A1:

Sub test()
Dim i, k, Lr As Long
With Sheets("Sheet1")
Lr = .Cells(Rows.Count, "A").End(xlUp).Row
For i = Lr To 1 Step -1
    If .Range("A" & i).Value = "" Then
    .Range("A" & i).Value = k
    k = 0
    Else
    k = k + .Range("A" & i).Value
    End If
Next
End With
End Sub

 

[Peter_SSs]

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)