sum subtotal VBA

[Excelnoobisme]

Hi,

i have a set of number that run in column A and B like these

Asset Amount
1 $100
1 $150


2 $250
2 $300
2 $200


3 $400
3 $350
3 $500


4 $50
4 $300


My Assets count will go into 2000+.
How can i write a macro so as it will shown the sum of each Asset in Column B(aka sub-total) and have a Grand total at the end.

 

[Domski]

Try this:

Sub Test()
    Range("A1").CurrentRegion.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Dom

 

[Excelnoobisme]

Not quite i wanted, i need to have the subtotal in column B and a grand total in column B at the end as well.

 

[Domski]

That's exactly what that does for me.

Book11
	A	B	C	D
1	Asset	Amount
2	1	100
3	1	150
4	1 Total	250
5	2	250
6	2	300
7	2	200
8	2 Total	750
9	3	400
10	3	350
11	3	500
12	3 Total	1250
13	4	50
14	4	300
15	4 Total	350
16	Grand Total	2600
Sheet1

Dom

 

[Excelnoobisme]

hmm but this is using the subtotal function. Is there a way to loop and sum each subtotal? additionally i already have 2 empty row inserted between each group of assets.

 

[Domski]

As you said 'aka sub-total' I assumed that was what you wanted to use. Will see what I can come up with.

Dom

 

[hiker95]

Excelnoobisme,


Sample data, with at least one space between groups, before the macro:

Excel Workbook
	A	B
1	Asset	Amount
2	1	$100
3	1	$150
4
5
6	2	$250
7	2	$300
8	2	$200
9
10
11	3	$400
12	3	$350
13	3	$500
14
15
16	4	$50
17	4	$300
18
19
20
21
Sheet1

After the macro:

Excel Workbook
	A	B
1	Asset	Amount
2	1	$100
3	1	$150
4		$250
5
6	2	$250
7	2	$300
8	2	$200
9		$750
10
11	3	$400
12	3	$350
13	3	$500
14		$1,250
15
16	4	$50
17	4	$300
18		$350
19
20		$2,600
21
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SumSubtotal()
' hiker95, 03/08/2011
' http://www.mrexcel.com/forum/showthread.php?t=534390
Dim BArea As Range, SR As Long, ER As Long, MyTot As Double
Application.ScreenUpdating = False
For Each BArea In Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With BArea
    SR = .Row
    ER = SR + .Rows.Count - 1
    With Cells(ER + 1, 2)
      .Value = "=SUM(B" & SR & ":B" & ER & ")"
      .Font.Bold = True
      .NumberFormat = "$#,##0"
    End With
    MyTot = MyTot + Cells(ER + 1, 2).Value
  End With
Next BArea
With Cells(ER + 3, 2)
  .Value = MyTot
  .Font.Bold = True
  .NumberFormat = "$#,##0"
End With
Application.ScreenUpdating = True
End Sub

Then run the SumSubtotal macro.

 

[Domenic]

Try modifying Dom's code as follows...

[font=Verdana][color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [color=darkblue]With[/color] Range("A1:B" & LastRow)
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=[color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]

[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[Excelnoobisme]

Thanks Hiker95,Domenic. it's work now. Thanks alot

 

[Domski]

My effort avoiding subtotal FWIW:

Sub test()

    Dim rngLoopRange As Range
    Dim dblGrandTot As Double
    Dim lngLastRow As Long

    lngLastRow = Cells(Rows.Count, 2).End(xlUp).Row
    For Each rngLoopRange In Range("B2:B" & lngLastRow).SpecialCells(xlCellTypeConstants).Areas
        rngLoopRange.Cells(rngLoopRange.Cells.Count).Offset(1) = Application.Sum(rngLoopRange)
        dblGrandTot = dblGrandTot + Application.Sum(rngLoopRange)
    Next rngLoopRange
    Range("B" & lngLastRow + 2) = dblGrandTot

End Sub

Dom