SUM Ranges depending on value with VBA - excel

Question

I'm trying to do the following with VBA. Imagine I have some data as it follows:
I would like my final result to be the sum of every data that is between "BEGINDATA" and "ENDDATA". So it would look like this:
My goal is to obtain the green data and write it next to "ENDDATA"
Any idea or suggestion?
Thank you so much!!

Answer 1

Try:
Option Explicit
Sub test()
Dim Lastrow As Long, BeginData As Long, EndData As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
If .Range("A" & i).Value = "BEGINDATA" Then
BeginData = i
ElseIf .Range("A" & i).Value = "ENDDATA" Then
EndData = i
End If
If EndData > BeginData Then
.Range("B" & i).Value = Application.Sum(.Range("B" & BeginData + 1 & ":B" & EndData - 1))
End If
Next i
End With
End Sub
Another Version:
Option Explicit
Sub test()
Dim Lastrow As Long, BeginData As Long, EndData As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
If .Range("A" & i).Value = "BEGINDATA" Then
BeginData = i
ElseIf .Range("A" & i).Value = "ENDDATA" Then
EndData = i
End If
If EndData > BeginData Then
With .Range("B" & i)
.Value = Application.Sum(Sheet1.Range("B" & BeginData + 1 & ":B" & EndData - 1))
.Interior.Color = vbGreen
End With
End If
Next i
End With
End Sub

Answer 2

You can also achieve this using Find which will be faster then looping
Option Explicit
Sub Demo()
Dim BeginData As Range, EndData As Range
Dim FirstBeginAddress As String
' Update with your range
With Sheet1.Columns(1)
Set BeginData = .Find(what:="BEGINDATA", after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole)
If Not BeginData Is Nothing Then
FirstBeginAddress = BeginData.Address
Set EndData = .Find("ENDDATA", after:=BeginData)
Do
Debug.Print "BeginAddress", BeginData.Address
If Not EndData Is Nothing And EndData.Row > BeginData.Row Then
Debug.Print "EndAddress", EndData.Address
'' For Formula
EndData.Offset(0, 1).Formula = "=SUM(" & Range(BeginData.Offset(1, 1), EndData.Offset(-1, 1)).Address & ")"
'' For value
'EndData.Offset(0, 1).Value2 = Application.Sum(Range(BeginData.Offset(1, 1), EndData.Offset(-1, 1)))
Set EndData = .Find("ENDDATA", after:=EndData)
Else
Err.Raise 998, "Demo", "Unable to find Data Footer"
End If
Set BeginData = .Find("BEGINDATA", after:=BeginData)
Loop Until BeginData Is Nothing Or BeginData.Address = FirstBeginAddress
Else
Err.Raise 999, "Demo", "Unable to find Data Header"
End If
End With
End Sub