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

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Domski

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
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
 

Excelnoobisme

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

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
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
 

Excelnoobisme

Board Regular
Joined
Nov 19, 2010
Messages
128

ADVERTISEMENT

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

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
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

Well-known Member
Joined
Apr 8, 2009
Messages
17,649

ADVERTISEMENT

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:

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,726
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]
 

Domski

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
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
 

Forum statistics

Threads
1,141,734
Messages
5,708,171
Members
421,550
Latest member
Dtcfire

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
Top