Consulting

Results 1 to 7 of 7

Thread: Dynamic Group by, with Subtotal and Grandtotal

  1. #1

    Dynamic Group by, with Subtotal and Grandtotal

    Hi VBA Forums,

    I’ve Been searching through the forums and I have seen similar posts to what I am looking for, but not all in the same post, so my code is continually not working properly. Any help is greatly appreciated as this is vexing me! I am sure for the experts this is simple(r)


    I am using a Webservice to pull data in one worksheet ‘Web Service Data’ and then rearranging this data and placing it into worksheet ‘Report’. I need to Sort on one Column to pull like values together, then add the total from another column, and then finally, to add a Grand Total of all of the totals.

    These are all dynamic values as there could be many columns to sort by.

    Here are more details to try to make my dilemma clear.
    Column A – Name
    Column C – the Plan Name. This is what I would like to group the rows by
    Column G – This is the cost for each item. I would like to add together all of the Costs that are part of the same group.

    So this is the ‘Pre’ View of the Data:
    Col A Col B Col C Col D Col E Col F Col G
    BoB Smith 512167 ZZ 2005-05-02-07:00 26859 11.1 10500
    ZZ 2007-11-09-08:00 30404 12.47 200000
    AA 2000-12-20-08:00 8331 23.1875 2500
    ZZ 2002-07-01-07:00 20288 5.88 2000
    ZZ 2003-07-01-07:00 21494 10.34 3000
    ZZ 2004-09-28-07:00 23715 13.18 23869
    AA 2004-09-28-07:00 23674 13.18 6131
    ZZ 2005-01-17-08:00 25071 23.02 15
    ZZ 2005-01-17-08:00 26031 15.9 187
    ZZ 2005-02-28-08:00 26513 13.35 15000
    ZZ 2008-06-02-07:00 31239 10.59 150000


    This is the Post – which shows the items sorted by Col C value, then Subtotaled per Group, and then with a Grand Total at the bottom.


    Col A Col B Col C Col D Col E Col F Col G
    BoB Smith 512167 AA 2000-12-20-08:00 8331 23.1875 2500
    AA 2004-09-28-07:00 23674 13.18 6131
    AA Total 8631

    ZZ 2002-07-01-07:00 20288 5.88 2000
    ZZ 2003-07-01-07:00 21494 10.34 3000
    ZZ 2004-09-28-07:00 23715 13.18 23869
    ZZ 2005-01-17-08:00 25071 23.02 15
    ZZ 2005-01-17-08:00 26031 15.9 187
    ZZ 2005-02-28-08:00 26513 13.35 15000
    ZZ 2005-05-02-07:00 26859 11.1 10500
    ZZ 2007-11-09-08:00 30404 12.47 200000
    ZZ 2008-06-02-07:00 31239 10.59 150000
    ZZ Total 404571

    Grand Total 413202


    Help is much appreciated in my time of need! I have attached the data to this thread for easier viewing.

    CDD

  2. #2
    VBAX Mentor MaximS's Avatar
    Joined
    Sep 2008
    Location
    Stoke-On-Trent
    Posts
    360
    Location
    one of the options might be using just formulas. but if that won't satisfy you we will think about macro option.

    see attachment for details.

  3. #3

    Reply

    Hi MaximS,

    I hesitate to use formulas as the number of items to Group by as well as the rows to add together varies greatly.

    Thanks for you help!
    CDD

  4. #4
    VBAX Mentor MaximS's Avatar
    Joined
    Sep 2008
    Location
    Stoke-On-Trent
    Posts
    360
    Location
    just if you need them to sort and have at the top, use copy>>paste as values and then sort.

  5. #5
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    [vba]
    Option Explicit
    Sub Macro1()
    Dim Rng As Range
    Dim Rw As Long
    Dim i As Long
    'Sort Data
    Rw = Cells(Rows.Count, 3).End(xlUp).Row
    Set Rng = Range(Cells(1, 3), Cells(Rw, 3)).Resize(, 4)
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("C1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending
    With ActiveSheet.Sort
    .SetRange Rng
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    'Insert spacing
    For i = Rw To 3 Step -1
    If Cells(i, 3) <> Cells(i - 1, 3) Then
    Cells(i, 3).Resize(2).EntireRow.Insert
    End If
    Next
    'Add Grand total
    Rw = Cells(Rows.Count, 3).End(xlUp).Row
    Cells(Rw + 3, 1) = "Grand Total"
    Cells(Rw + 3, 7) = Application.Sum(Range(Cells(Rw, 7), Cells(2, 7)))
    'Add Sub Totals
    Do
    Cells(Rw + 1, 1) = Cells(Rw, 3) & " Total"
    If Cells(Rw - 1, 7) = "" Then
    'Single items
    Cells(Rw + 1, 7) = Cells(Rw, 7)
    Rw = Cells(Rw, 3).End(xlUp).Row
    Else
    'Multiple items
    Cells(Rw + 1, 7) = Application.Sum(Range(Cells(Rw, 7), Cells(Rw, 7).End(xlUp)))
    Rw = Cells(Rw, 3).End(xlUp).End(xlUp).Row
    End If
    Loop Until Rw = 1
    End Sub

    [/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  6. #6
    Should this subroutine work in excel 2000?
    I am trying to modify it but get a runtime error 438 at:

    ActiveSheet.Sort.SortFields.Clear

    Regards,
    Chris

  7. #7
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    It will probably work OK if the offending line is deleted. Also, try recoding your own macro doing a Sort; that should give you the correct syntax.
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •