Using VBA to sum columns 1

[Cornerstone]

I want a procedure to move to a column, sum all of the cells above that cell up to the first empty cell and then do the same thing in 4 more adjacent columns to the right.

I cannot predict how many rows of data will be summed. It would have to know to sum everything from one cell above the cellpointer all the way up to the first empty cell.

I used the following procedure and it works however the result is the value not a function so if any data changes the macro would have to be rerun. Any ideas? Thanks.

Sub Test()

Application.ScreenUpdating = False

Dim x As Double
Dim currentcell As String
Dim i As Integer

ActiveCell.Offset(0, 3).Select

For i = 0 To 4

x = 0
ActiveCell.Offset(0, 1).Select
currentcell = ActiveCell.Address

Do
ActiveCell.Offset(-1, 0).Select
x = x + ActiveCell.Value
Loop Until IsEmpty(ActiveCell.Value)

Range(currentcell).Select
ActiveCell.Value = x

Next i
Application.ScreenUpdating = True
End Sub

 

[vbMax]

The following procedure will assign a formula and not a value:

Sub Test()

Dim x As Double
Dim currentcell As String
Dim i As Integer
Dim counter As Long

ActiveCell.Offset(0, 3).Select

For i = 0 To 4

x = 0
ActiveCell.Offset(0, 1).Select
currentcell = ActiveCell.Address
counter = 0

Do
ActiveCell.Offset(-1, 0).Select
x = x + ActiveCell.Value
counter = counter + 1
Loop Until IsEmpty(ActiveCell.Value)

Range(currentcell).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & Trim(Str(counter)) & "]C:R[-1]C)"

Next i

End Sub