Excel VBA Sum Dynamic Range

[Nicoo00]

Hi,

I am using a VBA that I found here to sum ranges until a cell (all in one column; A) is empty.

VBA:

Sub MultipleLines()
    Dim cell As Range
    Dim offset_rows As Long


    Set cell = ActiveCell
'or Range("A8").Select
    
    Do While Not IsEmpty(cell.Offset(2, 0))
        offset_rows = Range(cell, cell.End(xlDown)).Rows.Count - 1
        Set cell = cell.End(xlDown).Offset(1, 0)
        cell.FormulaR1C1 = "=SUM(R[-" & offset_rows & "]C:R[-1]C)"
    Loop
End Sub

Example:
1
1
(empty cell)

2
3
4
(empty cell)

This works fine, although "ranges" with only one row are skipped. Does anyone know how I can adjust the VBA so it just puts in =SUM(A###), correct cell reference, in case it is only one row/cell followed by an empty cell?

Thank you in advance.

Niek

 

[MickG]

Try this :-

[COLOR="Navy"]Sub[/COLOR] MG09Mar25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A8", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Rng = Rng.SpecialCells(xlCellTypeConstants)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    Dn(Dn.Count).Offset(1).Formula = "=Sum(" & Dn.Address & ")"
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick