Results 1 to 9 of 9
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts

    Code to compute sub-total data two rows after last value in each group

    I have a spreadsheet containing values in D. The data is imported on a monthly basis

    I have manually computed the sub-total two rows after the last row containing data for each group of data

    I am looking for code to do this, but not sure how to do this, although I have attempted this, but it needs to be modified to work properly


    I have attached sample data


    It would be appreciated if someone could kindly help me

    Code:
     Sub Sub_totals()
    Dim lr As Long, r As Long
    lr = Cells(Rows.Columns.Count, "D").End(xlUp).Row
    For r = lr To 3 Step -1
        If Range("D" & r).Value > 0 And Range("C" & r).Value <> "" Then
            Rows(r).Offset(, 1).FormulaR1C1 = "=SUBTOTAL(9,R[-5]C:R[-1]C)"
            
            
            End If
    Next r
    End Sub
    Attached Files Attached Files

  2. #2
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi Howard

    ..your posted example grand total is incorrect.
    (one of your subtotals is also incorrect - it is 'missing' a data row)

    Instead of using the SUBTOTAL functions for each group, you could perhaps just use SUM for each grouping.
    Then , for the grand total, you just use SUM again, and divide that value by 2.

    I'll post a file tomorrow.

    zeddy

  3. #3
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,641
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Hi Howard,

    The following code should do what you want to do

    Code:
    Public Sub Totals()
    '----------------------------------------
    'DECLARE AND SET VARIABLES
    Dim items, Totals As Currency, Subtotals As Currency
    Dim I As Integer, Group As Integer, LastRow As Integer
    LastRow = Cells(Rows.Columns.Count, "D").End(xlUp).Row
    items = Array("Shirt", "Jeans", "Pyjamas")
    '----------------------------------------
    'CLEAR TOTALS AND SUBTOTALS
    For I = 1 To LastRow
        If Cells(I, 3) = "Subtotal:" Or Cells(I, 3) = "Totals:" Then
            Cells(I, 4).ClearContents
        End If
    Next I
    '----------------------------------------
    'CALCULATE NEW SUBTOTALS
    Subtotal = 0
    For Group = 0 To UBound(items)
        Index = 0
        For I = 1 To LastRow
            If InStr(1, Cells(I, 3), items(Group), vbTextCompare) > 1 Then
                Subtotal = Subtotal + Cells(I, 4)
                Line = I
            End If
        Next I
        Cells(Line + 2, 3) = "Subtotal:"
        Cells(Line + 2, 4) = Subtotal
        Total = Total + Subtotal
        Subtotal = 0
    Next Group
    '----------------------------------------
    'CALCULATE TOTALS
    LastRow = Cells(Rows.Columns.Count, "D").End(xlUp).Row
    Cells(LastRow + 2, 3) = "Totals:"
    Cells(LastRow + 2, 4) = Total
    End Sub
    Attached Files Attached Files

  4. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2016-05-07)

  5. #4
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Maud

    Thanks for your code, which works perfectly

    I have another sample file to compute Sub-totals, which is a bit more complicated in that each branch name appears In Col A before the stock Number. The stock number begins with two Alphas and ends with four numeric values. I need the sub totals computed for each of the branches as well as a grand total for all the branches


    It would be appreciated if you could assist me




    Howard
    Attached Files Attached Files

  6. #5
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Zeddy

    Thanks for pointing this out. Look forward to receiving your code

    I have attached another sample file-see Post # 4



    Howard

  7. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,641
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Howard,

    I amended my previous code to accommodate this report.

    HTH,
    Maud

    Code:
    Public Sub Totals()
    '----------------------------------------
    'DECLARE AND SET VARIABLES
    Dim items, Totals As Currency, Subtotals As Currency
    Dim I As Integer, Group As Integer, LastRow As Integer
    LastRow = Cells(Rows.Columns.Count, "C").End(xlUp).Row
    items = Array("PRT", "Heath PE", "Zoltle PE", "Wa PE", "Po ME", "LEX")
    '----------------------------------------
    'CLEAR TOTALS AND SUBTOTALS
    For I = 1 To LastRow
        If Cells(I, 3) = "Subtotal:" Or Cells(I, 3) = "Totals:" Then
            Cells(I, 4).ClearContents
        End If
    Next I
    '----------------------------------------
    'CALCULATE NEW SUBTOTALS
    Subtotal = 0
    Total = 0
    For Group = 0 To UBound(items)
        For I = 1 To LastRow
            If Cells(I, 1) = items(Group) Then
                StartRow = I + 1
                For J = StartRow To LastRow + 1
                    If Cells(J, 1) <> "" Then
                        Subtotal = Subtotal + Val(Cells(J, 4))
                     Else
                        Cells(J + 1, 3) = "Subtotal:"
                        Cells(J + 1, 4) = Subtotal
                        Total = Total + Subtotal
                        Subtotal = 0
                        GoTo nextgroup
                    End If
                Next J
            End If
        Next I
    nextgroup:
    Next Group
    '----------------------------------------
    'CALCULATE TOTALS
    LastRow = Cells(Rows.Columns.Count, "D").End(xlUp).Row
    Cells(LastRow + 2, 3) = "Totals:"
    Cells(LastRow + 2, 4) = Total
    End Sub
    Attached Files Attached Files

  8. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2016-05-08)

  9. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Thanks for all your effort Maud

    Code Works Perfectly

    Howard

  10. #8
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi Howard

    In addition to Maud's excellent method, I attach my version.
    I'm including this because I finally found a place where I could use rgbDodgerBlue in code.
    (Well, it sounds like a car colour to me!)

    Also, you get to learn vba by looking at different ways of doing stuff!

    zeddy
    Attached Files Attached Files

  11. The Following User Says Thank You to zeddy For This Useful Post:

    HowardC (2016-05-08)

  12. #9
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Zeddy

    Thanks very much for all the effort

    Have tested on my data and it works perfectly

    Howard

Posting Permissions

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