*Sample excel file attached at the bottom of this post*
I'm trying to add subtotals beneath customers in a list that has multiple entries. Multiple entries also are grouped together with group number on the left. Unique customers with only one order are not assigned a group number. I already got it to identify the grouped customers and add a subtotal line but my code doesn't pick up on the later groups and fails to add a subtotal line beneath that.
I'm trying to add subtotals beneath customers in a list that has multiple entries. Multiple entries also are grouped together with group number on the left. Unique customers with only one order are not assigned a group number. I already got it to identify the grouped customers and add a subtotal line but my code doesn't pick up on the later groups and fails to add a subtotal line beneath that.
Code:
Sub AddingSubtotals()
Dim GroupNumber
Dim OrdersPerCustomer
Dim i
Dim Subtotals
GroupNumber = 1
OrdersPerCustomer = 0
i = 1
Subtotals = 1
OrdersCount = Application.CountA(Range("C5:C1048576"))
OrdersAndSubtotals = OrdersCount + Subtotals
If GroupNumber = ActiveSheet.Cells(i + 1, 1) Then
Do While GroupNumber = ActiveSheet.Cells(i + 1, 1)
OrdersPerCustomer = OrdersPerCustomer + 1
i = i + 1
Loop
'this adds and formats new line with subtotal information
ActiveSheet.Cells(i + 1, 1).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Interior.Color = RGB(210, 210, 210)
Cells(i + 1, 3).FormulaR1C1 = "Subtotal (" & Cells(i + 1, 3).Offset(-1, 0) & ")"
Cells(i + 1, 4).FormulaR1C1 = "=SUM(R[-" & OrdersPerCustomer & "]C:R[-1]C)"
Subtotals = Subtotals + 1
GroupNumber = GroupNumber + 1
'this is the part i need help with
Else
Do While IsEmpty(ActiveSheet.Cells(i + 1, 1))
i = i + 1
Loop
End If
End Sub