CODEWITHSUNDEEP
vbaexcel
Tefalpan
Tefalpan

Reputation: 94

Excel VBA sum with dynamic range

I'm trying to create a excel macro calculating a sum of values in column A, using a certain dynamic range.

Basic excel example screenshot included below:

Excel snapshot

The final goal is to loop through the cells in column B till a "0" is reached. When a "0" is reached, in column A of that same row, a sum of all the values in column A is calculated until a new "0" in column B is reached. So in this basic example A1 should contain =sum(A2:A7) and A8 should contain the sum of the values A9 through A14.

My progress so far included below, still pretty new at all the VBA stuff.

Sub sumtill0()
'
' sumtill0 Macro
'

'
Cells(ActiveCell.Row, 1).Select
If Sheets("Blad1").Cells(2, 1).Value = nil And Sheets("Blad1").Cells(2, 1).Value <> "0" Then
    Sheets("Blad1").Activate
    Cells(2, 1).Range("A1").Select
       Else
    Dim artTekst As String
    If Sheets("Blad1").Cells(1, 2).Value = "0" Then
        Sheets("Blad1").Cells(1, 1).Fomula = "=SUM()"
    Else
        If Sheets("Blad1").Cells(1, 2).End(xlDown).Value = "0" Then
            Sheets("Blad1").Cells(1, 1).End(xlDown).Offset(1, 0).Value = "0"
            Sheets("Blad1").Cells(1, 1).End(xlDown).Fomula = "=SUM(???)"
            ActiveCell.Value = Sheets("Blad1").Cells(1, 2).End(xlDown).Offset(0, -2).Value
    End If

End If

End If

End Sub

Thanks :)

Upvotes: 0

Views: 8374

Answers (1)

SJR
SJR

Reputation: 23081

Think this does what you want. It uses the Find method to find successive zeros and sums the range between each pair. If it cycles back to the start value, it sums to the bottom value (not sure what should happen if the first value in B is not zero).

Sub x()

Dim rFind As Range, s As String, r1 As Range

With Range("B1", Range("B" & Rows.Count).End(xlUp))
    Set rFind = .Find(What:=0, After:=.Cells(.Cells.Count), LookIn:=xlFormulas, _
                      Lookat:=xlWhole, SearchDirection:=xlNext, searchFormat:=False)
    If Not rFind Is Nothing Then
        s = rFind.Address
        Do
            Set r1 = rFind
            Set rFind = .FindNext(rFind)
            If rFind.Address = s Then
                Set rFind = .Cells(.Cells.Count)
                r1.Offset(, -1).Value = Application.Sum(Range(r1.Offset(1, -1), rFind.Offset(, -1)))
                Exit Sub
            End If
            r1.Offset(, -1).Value = Application.Sum(Range(r1.Offset(1, -1), rFind.Offset(-1, -1)))
        Loop While rFind.Address <> s
    End If
End With

End Sub

Upvotes: 1

Related Questions