# Thread: Code to compute sub-total data two rows after last value in each group

1. ## Code to compute sub-total data two rows after last value in each group

I have a spreadsheet containing values in D. The data is imported on a monthly basis

I have manually computed the sub-total two rows after the last row containing data for each group of data

I am looking for code to do this, but not sure how to do this, although I have attempted this, but it needs to be modified to work properly

I have attached sample data

It would be appreciated if someone could kindly help me

Code:
``` Sub Sub_totals()
Dim lr As Long, r As Long
lr = Cells(Rows.Columns.Count, "D").End(xlUp).Row
For r = lr To 3 Step -1
If Range("D" & r).Value > 0 And Range("C" & r).Value <> "" Then
Rows(r).Offset(, 1).FormulaR1C1 = "=SUBTOTAL(9,R[-5]C:R[-1]C)"

End If
Next r
End Sub```

2. Hi Howard

..your posted example grand total is incorrect.
(one of your subtotals is also incorrect - it is 'missing' a data row)

Instead of using the SUBTOTAL functions for each group, you could perhaps just use SUM for each grouping.
Then , for the grand total, you just use SUM again, and divide that value by 2.

I'll post a file tomorrow.

zeddy

3. Hi Howard,

The following code should do what you want to do

Code:
```Public Sub Totals()
'----------------------------------------
'DECLARE AND SET VARIABLES
Dim items, Totals As Currency, Subtotals As Currency
Dim I As Integer, Group As Integer, LastRow As Integer
LastRow = Cells(Rows.Columns.Count, "D").End(xlUp).Row
items = Array("Shirt", "Jeans", "Pyjamas")
'----------------------------------------
'CLEAR TOTALS AND SUBTOTALS
For I = 1 To LastRow
If Cells(I, 3) = "Subtotal:" Or Cells(I, 3) = "Totals:" Then
Cells(I, 4).ClearContents
End If
Next I
'----------------------------------------
'CALCULATE NEW SUBTOTALS
Subtotal = 0
For Group = 0 To UBound(items)
Index = 0
For I = 1 To LastRow
If InStr(1, Cells(I, 3), items(Group), vbTextCompare) > 1 Then
Subtotal = Subtotal + Cells(I, 4)
Line = I
End If
Next I
Cells(Line + 2, 3) = "Subtotal:"
Cells(Line + 2, 4) = Subtotal
Total = Total + Subtotal
Subtotal = 0
Next Group
'----------------------------------------
'CALCULATE TOTALS
LastRow = Cells(Rows.Columns.Count, "D").End(xlUp).Row
Cells(LastRow + 2, 3) = "Totals:"
Cells(LastRow + 2, 4) = Total
End Sub```

4. ## The Following User Says Thank You to Maudibe For This Useful Post:

HowardC (2016-05-07)

5. Hi Maud

Thanks for your code, which works perfectly

I have another sample file to compute Sub-totals, which is a bit more complicated in that each branch name appears In Col A before the stock Number. The stock number begins with two Alphas and ends with four numeric values. I need the sub totals computed for each of the branches as well as a grand total for all the branches

It would be appreciated if you could assist me

Howard

6. Hi Zeddy

Thanks for pointing this out. Look forward to receiving your code

I have attached another sample file-see Post # 4

Howard

7. Howard,

I amended my previous code to accommodate this report.

HTH,
Maud

Code:
```Public Sub Totals()
'----------------------------------------
'DECLARE AND SET VARIABLES
Dim items, Totals As Currency, Subtotals As Currency
Dim I As Integer, Group As Integer, LastRow As Integer
LastRow = Cells(Rows.Columns.Count, "C").End(xlUp).Row
items = Array("PRT", "Heath PE", "Zoltle PE", "Wa PE", "Po ME", "LEX")
'----------------------------------------
'CLEAR TOTALS AND SUBTOTALS
For I = 1 To LastRow
If Cells(I, 3) = "Subtotal:" Or Cells(I, 3) = "Totals:" Then
Cells(I, 4).ClearContents
End If
Next I
'----------------------------------------
'CALCULATE NEW SUBTOTALS
Subtotal = 0
Total = 0
For Group = 0 To UBound(items)
For I = 1 To LastRow
If Cells(I, 1) = items(Group) Then
StartRow = I + 1
For J = StartRow To LastRow + 1
If Cells(J, 1) <> "" Then
Subtotal = Subtotal + Val(Cells(J, 4))
Else
Cells(J + 1, 3) = "Subtotal:"
Cells(J + 1, 4) = Subtotal
Total = Total + Subtotal
Subtotal = 0
GoTo nextgroup
End If
Next J
End If
Next I
nextgroup:
Next Group
'----------------------------------------
'CALCULATE TOTALS
LastRow = Cells(Rows.Columns.Count, "D").End(xlUp).Row
Cells(LastRow + 2, 3) = "Totals:"
Cells(LastRow + 2, 4) = Total
End Sub```

8. ## The Following User Says Thank You to Maudibe For This Useful Post:

HowardC (2016-05-08)

9. Thanks for all your effort Maud

Code Works Perfectly

Howard

10. Hi Howard

In addition to Maud's excellent method, I attach my version.
I'm including this because I finally found a place where I could use rgbDodgerBlue in code.
(Well, it sounds like a car colour to me!)

Also, you get to learn vba by looking at different ways of doing stuff!

zeddy

11. ## The Following User Says Thank You to zeddy For This Useful Post:

HowardC (2016-05-08)

12. Hi Zeddy

Thanks very much for all the effort

Have tested on my data and it works perfectly

Howard

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•