sum subtotal VBA

Excelnoobisme

Board Regular
Joined
Nov 19, 2010
Messages
128
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.
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Try this:

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


Dom
 
Upvote 0
That's exactly what that does for me.
Book11
ABCD
1AssetAmount
21100
31150
41 Total250
52250
62300
72200
82 Total750
93400
103350
113500
123 Total1250
13450
144300
154 Total350
16Grand Total2600
Sheet1


Dom
 
Upvote 0
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.
 
Upvote 0
As you said 'aka sub-total' I assumed that was what you wanted to use. Will see what I can come up with.

Dom
 
Upvote 0
Excelnoobisme,


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


Excel Workbook
AB
1AssetAmount
21$100
31$150
4
5
62$250
72$300
82$200
9
10
113$400
123$350
133$500
14
15
164$50
174$300
18
19
20
21
Sheet1





After the macro:


Excel Workbook
AB
1AssetAmount
21$100
31$150
4$250
5
62$250
72$300
82$200
9$750
10
113$400
123$350
133$500
14$1,250
15
164$50
174$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.


Code:
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.
 
Last edited:
Upvote 0
Try modifying Dom's code as follows...

Code:
[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]
 
Upvote 0
My effort avoiding subtotal FWIW:

Code:
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
 
Upvote 0

Forum statistics

Threads
1,222,312
Messages
6,165,278
Members
451,949
Latest member
bovacik

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top