Results 1 to 9 of 9

20160507, 08:43 #1
 Join Date
 Feb 2008
 Posts
 1,495
 Thanks
 135
 Thanked 7 Times in 7 Posts
Code to compute subtotal 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 subtotal 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

20160507, 15:41 #2
 Join Date
 Mar 2002
 Location
 Newcazzle, UK
 Posts
 3,188
 Thanks
 152
 Thanked 591 Times in 561 Posts
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

20160507, 15:59 #3
 Join Date
 Aug 2010
 Location
 Pa, USA
 Posts
 2,790
 Thanks
 139
 Thanked 705 Times in 639 Posts
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

The Following User Says Thank You to Maudibe For This Useful Post:
HowardC (20160507)

20160507, 22:00 #4
 Join Date
 Feb 2008
 Posts
 1,495
 Thanks
 135
 Thanked 7 Times in 7 Posts
Hi Maud
Thanks for your code, which works perfectly
I have another sample file to compute Subtotals, 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

20160507, 22:08 #5
 Join Date
 Feb 2008
 Posts
 1,495
 Thanks
 135
 Thanked 7 Times in 7 Posts
Hi Zeddy
Thanks for pointing this out. Look forward to receiving your code
I have attached another sample filesee Post # 4
Howard

20160507, 23:25 #6
 Join Date
 Aug 2010
 Location
 Pa, USA
 Posts
 2,790
 Thanks
 139
 Thanked 705 Times in 639 Posts
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

The Following User Says Thank You to Maudibe For This Useful Post:
HowardC (20160508)

20160508, 02:03 #7
 Join Date
 Feb 2008
 Posts
 1,495
 Thanks
 135
 Thanked 7 Times in 7 Posts
Thanks for all your effort Maud
Code Works Perfectly
Howard

20160508, 07:22 #8
 Join Date
 Mar 2002
 Location
 Newcazzle, UK
 Posts
 3,188
 Thanks
 152
 Thanked 591 Times in 561 Posts
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

The Following User Says Thank You to zeddy For This Useful Post:
HowardC (20160508)

20160508, 09:28 #9
 Join Date
 Feb 2008
 Posts
 1,495
 Thanks
 135
 Thanked 7 Times in 7 Posts
Hi Zeddy
Thanks very much for all the effort
Have tested on my data and it works perfectly
Howard