Sum up value with different keys - excel

Question

Please refer to the attached picture to have a better idea.
I have multiple rows in my worksheet with a group name and a lot of values. Each group shows multiple times in my table. Now I would like to sum values for every group and return them. What is the most efficient way to do this?
Now I have the code to store each row's total value to an array and sum it up like below:
Dim arr() as variant
Dim n as integer
Dim sum as variant
For n = firstrow to lastrow 'assume firstrow and lastrow are known numbers
arr = Range(Cells(n, 3),Cells(n,column.count)).Value
sum = Workbookfunction.sum(arr)
Next n
Any thoughts will be quite helpful!

Answer 1

Use SUMPRODUCT:
=SUMPRODUCT(($A$7:$A$18=A1)*($B$7:$G$18))

Answer 2

A VBA Array Version
Before using this code adjust the data in the customize section to fit your needs.
The commented blocks starting with ' str1 = " are used for debugging. You can delete them or uncomment them to see some 'subtotals' in the immediate window.
Option Explicit
Sub SumGroups()
'-- Customize BEGIN --------------------
Const cStrG As String = "B2" 'First cell of the group section
Const cStrD As String = "B15" 'First cell of the data section
'-- Customize END ----------------------
Dim oRng As Range
Dim oRngResults As Range
Dim arrNames As Variant
Dim arrData As Variant
Dim arrResults As Variant
Dim loNames As Long
Dim loData As Long
Dim iDataCol As Integer
Dim dblResults As Double
'Debug
Dim lo1 As Long
Dim i1 As Integer
Dim str1 As String
Dim str2 As String
Dim dTime As Double
' 'Determine the group names range using the first cell of the data section.
' Set oRng = Range(cStrG).Resize(Range(cStrD).Rows.End(xlUp).Row - 1, 1)
'Determine the group names range using the last cell of the group section.
Set oRng = Range(cStrG).Resize(Range(cStrG).Rows.End(xlDown).Row - 1, 1)
'Determine the range of the results
Set oRngResults = oRng.Offset(0, 1)
'Paste the group names range into an array
arrNames = oRng
' str1 = "arrNames:"
' For lo1 = LBound(arrNames) To UBound(arrNames)
' str1 = str1 & vbCrLf & lo1 & ". " & Chr(9) & arrNames(lo1, 1)
' Next
' Debug.Print str1
'Determine the data range using resize NOT finished.
' Set oRng = Range(cStrD).Resize(Cells(Cells.Rows.Count, _
Range(cStrD).Column).End(xlUp).Row - Range(cStrD).Row + 1, 1)
'Determine the data range not using resize.
Set oRng = Range(Cells(Range(cStrD).Row, Range(cStrD).Column), _
Cells(Cells(Cells.Rows.Count, Range(cStrD).Column).End(xlUp).Row, _
Cells(Range(cStrD).Row, Cells.Columns.Count).End(xlToLeft).Column))
'Paste the data range into an array
arrData = oRng
Set oRng = Nothing 'Release object variable
' str1 = "arrData:"
' For lo1 = LBound(arrData) To UBound(arrData)
' str2 = ""
' For i1 = LBound(arrData, 2) To UBound(arrData, 2)
' str2 = str2 & Chr(9) & arrData(lo1, i1)
' Next
' str1 = str1 & vbCrLf & lo1 & "." & str2
' Next
' Debug.Print str1
arrResults = oRngResults
For loNames = LBound(arrNames) To UBound(arrNames)
dblResults = 0
For loData = LBound(arrData) To UBound(arrData)
If arrNames(loNames, 1) = arrData(loData, 1) Then
For iDataCol = LBound(arrData, 2) + 1 To UBound(arrData, 2)
dblResults = dblResults + arrData(loData, iDataCol)
Next
End If
Next
arrResults(loNames, 1) = dblResults
Next
' str1 = "arrResults:"
' For lo1 = LBound(arrResults) To UBound(arrResults)
' str1 = str1 & vbCrLf & lo1 & ". " & Chr(9) & arrResults(lo1, 1)
' Next
' Debug.Print str1
oRngResults = arrResults
Set oRngResults = Nothing 'Release object variable
End Sub
At 50000 rows it calculates in less than a second. The determination of the ranges gave me quite some grief, but I still think they could probably be improved. Would appreciate some feedback regarding the ranges.

Answer 3

I've rewritten the code to use instead of yours. It adds up all the rows between two row indexes, as long as the first cell in each row has a value of "Group A".
Dim firstRow As Integer
Dim lastRow As Integer
Dim currentSum As Integer
Dim currentGroup As String
'Change firstRow and lastRow to the row indexes of the cells you're adding
firstRow = 10
lastRow = 13
currentSum = 0
currentGroup = "Group A"
For n = firstRow To lastRow
If Cells(n, 1).Value = currentGroup Then
currentSum = currentSum + Application.sum(Range(Cells(n, 1), Cells(n, 50)))
End If
'Put the cell name of where you want the value, instead of B3
Range("B3").Value = currentSum
'Change currentGroup to the next group here
Next n