sum subtotal VBA

E

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.
 
Sort by date Sort by votes
Have you considered doing this on on pivot table instead of trying to write VBA?

Set up the pivot to include both Assets and Amount as row fields, and summarize data as sum of assets?

You'll get subtotals and grand total along with detail data all in the same column.

if you don't like seeing the 'amounts' in the left column, you can set the table to tabular view and then hide the 'amounts' column.
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Thanks Domski, your work perfectly as well. Thanks

Capparfrank, i think of that before but i need the report for regulatory submission and i have a format to follow. Sorry if i sound choosy. But thanks to Domski and hiker, it work perfectly now
 
Upvote 0
HI,

run into some problem. i try to format the cell with all the subtotal and grand total with .Border and cant seem to make it work. i wish to to have 'Top and Bottom Border' for cell with subtotal and grand total.
 
Upvote 0
Excelnoobisme,


Sample date 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 updated 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).


Code: 
Option Explicit
Sub SumSubtotalV2()
' 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"
      With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
    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"
  With .Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
  End With
  With .Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
  End With
End With
Application.ScreenUpdating = True
End Sub


Then run the SumSubtotalV2 macro.
 
Upvote 0
Domski said:
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
Click to expand...


if assuming im using Domski initial method (aka subtotal) how can i insert a row after every subtotal? in addition i wish the the subtotal cell to be bold and have top and bottom border. Is there a way to do it?
 
Upvote 0
Try...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

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

    [color=darkblue]Dim[/color] SearchRng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FoundCell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstAddress [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] SummaryBelow [color=darkblue]As[/color] [color=darkblue]Boolean[/color]

    SummaryBelow = [color=darkblue]True[/color]

    Range("A1").CurrentRegion.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=SummaryBelow
        
    [color=darkblue]Set[/color] SearchRng = Intersect(ActiveSheet.UsedRange, Columns("A"))
    
    [color=darkblue]With[/color] SearchRng
        [color=darkblue]Set[/color] FoundCell = .Find("* Total", LookIn:=xlValues, lookat:=xlWhole)
        [color=darkblue]If[/color] [color=darkblue]Not[/color] FoundCell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            FirstAddress = FoundCell.Address
            [color=darkblue]Do[/color]
                [color=darkblue]With[/color] FoundCell.Offset(, 1).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .Weight = xlThin
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                [color=darkblue]With[/color] FoundCell.Offset(, 1).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .Weight = xlThin
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                [color=darkblue]If[/color] InStr(FoundCell, "Grand") > 0 [color=darkblue]Then[/color]
                    [color=seagreen]'Do nothing[/color]
                [color=darkblue]Else[/color]
                    [color=darkblue]If[/color] SummaryBelow = [color=darkblue]True[/color] [color=darkblue]Then[/color]
                        FoundCell.Offset(1, 1).EntireRow.Insert
                    [color=darkblue]Else[/color]
                        FoundCell.Offset(, 1).EntireRow.Insert
                    [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]Set[/color] FoundCell = .FindNext(FoundCell)
            [color=darkblue]Loop[/color] [color=darkblue]While[/color] FoundCell.Address <> FirstAddress
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[/font]

For summary above the data, replace...

Code: 
SummaryBelow = True

with

Code: 
SummaryBelow = False
 
Upvote 0
Thanks Dom, work perfectly. 1 more question, i wish to have my cell pointing at 2 cells below the Grand Total after the macro, what will it be? Also, if i have 30 tabs, i wish to sort all column A from smallest to largest then run the above code, what will i have to add?
 
Upvote 0
Try...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

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

    [color=darkblue]Dim[/color] SearchRng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FoundCell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstAddress [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] SummaryBelow [color=darkblue]As[/color] [color=darkblue]Boolean[/color]

    SummaryBelow = [color=darkblue]True[/color]
    
    [color=seagreen]'Sort the data[/color]
    [color=darkblue]With[/color] Range("A1", Cells(Rows.Count, "B").End(xlUp))
        .Sort key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    [color=darkblue]End[/color] [color=darkblue]With[/color]

    [color=seagreen]'Subtotal the data[/color]
    Range("A1").CurrentRegion.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=SummaryBelow
        
    [color=darkblue]Set[/color] SearchRng = Intersect(ActiveSheet.UsedRange, Columns("A"))
    
    [color=seagreen]'Format the data[/color]
    [color=darkblue]With[/color] SearchRng
        [color=darkblue]Set[/color] FoundCell = .Find("* Total", LookIn:=xlValues, lookat:=xlWhole)
        [color=darkblue]If[/color] [color=darkblue]Not[/color] FoundCell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            FirstAddress = FoundCell.Address
            [color=darkblue]Do[/color]
                [color=darkblue]With[/color] FoundCell.Offset(, 1).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .Weight = xlThin
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                [color=darkblue]With[/color] FoundCell.Offset(, 1).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .Weight = xlThin
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                [color=darkblue]If[/color] InStr(FoundCell, "Grand") > 0 [color=darkblue]Then[/color]
                    [color=darkblue]If[/color] SummaryBelow [color=darkblue]Then[/color] FoundCell.Offset(2).Select
                [color=darkblue]Else[/color]
                    [color=darkblue]If[/color] SummaryBelow = [color=darkblue]True[/color] [color=darkblue]Then[/color]
                        FoundCell.Offset(1, 1).EntireRow.Insert
                    [color=darkblue]Else[/color]
                        FoundCell.Offset(, 1).EntireRow.Insert
                    [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]Set[/color] FoundCell = .FindNext(FoundCell)
            [color=darkblue]Loop[/color] [color=darkblue]While[/color] FoundCell.Address <> FirstAddress
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[/font]
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Subtotals within Sumifs range
Replies
6
Views
218
jaz44
J
G
  • Solved
SUMIF for increases in row of data
Replies
5
Views
148
gopalgriffith
G
C
  • Question
Filter using subtotal or countif question
Replies
1
Views
200
arthurbr
arthurbr
J
  • Solved
Sum Product Formula
Replies
2
Views
103
Dave Patton
D
I
  • Solved
Running Total In Column C Based On Date Change in Column B
Replies
3
Views
198
Fluff
Fluff

Forum statistics

Threads
1,214,646
Messages
6,120,718
Members
448,986
Latest member
andreguerra

Share this page

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