Continuous Sum Function
I am trying to make a simple sum function that sums until I hit a blank cell. I am not sure why it is not working. I am trying to sum currency and have the output be a currency as well. So far I have:
Function SumContin(X) Dim Ro As Long Dim Col As Long Dim Ro1 As Long Dim Col1 As Long Ro = Application.WorksheetFunction.Row(X) Col = Application.WorksheetFunction.Column(X) Do While Cells(Ro, Col) <> "" Sum = Sum + CInt(Cells(Ro, Col)) Ro = Ro - 1 Loop End Function
Follow up from comments:
Can I make the function where it will be =SumContin() and it starts from the cell above?
Function SumContin() Application.Volatile SumContin = 0 On Error Resume Next With Application.ThisCell If .Row = 1 Then Exit Function If .Offset(-1) = "" Then Exit Function SumContin = Application.Sum(Range(.Offset(-1), .End(xlUp))) End With End Function
Note: since code using Application.ThisCell, function will work only in case when you call it from worksheet: =SumContin() and won't work if you call it from any code
A UDF for this seems overkill given that in the A provided the requisite range has to be keyed in anyway. A running total something like =SUM(A$1:A1) and double-clicking on the fill handle may be more convenient at times.
It would be most efficient to just define the range withing the UDF based on the cell passed, and then use the WorksheetFunction.Sum command.
Here's one way:
Function SumContin(X As Range) SumContin = WorksheetFunction.Sum(Range(X.Address & ":" & X.End(xlDown).Address)) End Function