Consulting

Results 1 to 5 of 5

Thread: Solved: Formula in moving array

  1. #1
    VBAX Regular
    Joined
    Dec 2006
    Posts
    69
    Location

    Solved: Formula in moving array

    I've got a spreadsheet of data by specific part numbers. I have a macro to sum an array based on where the user places the cursor (1 line below what they want grouped/summed). In the example below, the user would select the cell containing 4210B and the macro would add 2 rows and sum the array above it (4210 series)....giving you a subtotal by product group for each month and a total for the year.

    P/N Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec Total %tot
    4210B 0 0 20 41 42 38 51 35 38 55 52 48 420
    4210C 0 5 10 10 10 15 10 15 10 5 10 15 115
    4260B 1 5 4 10 8 5 7 5 3 2 5 5 60
    4260C 20 20 20 20 20 20 20 20 20 20 20 20 240
    4260D 10 10 10 10 10 10 10 10 10 10 10 10 120
    4277B 5 5 5 5 5 5 5 5 5 5 5 5 60
    4277C 1 1 1 1 1 1 1 1 1 1 1 1 12

    Here is that code:

    [vba] Do While Not IsEmpty(ActiveCell.Offset(-1, 0))
    If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else _
    Set TopCell = ActiveCell.Offset(-1, 0).End(xlUp)
    If IsEmpty(ActiveCell) Then Set BottomCell = ActiveCell.Offset(-1, 0) Else _
    Set BottomCell = ActiveCell
    Set MyArray = Range(TopCell, BottomCell)

    ActiveCell.Formula = MySum(MyArray)
    ActiveCell.Offset(0, 1).Range("A1").Select
    Loop
    [/vba]

    The problem I'm having is that I need to add a percent total in the last column (next to the 12 month total). The formula is the 12-month total per item number devided by the total for the series. In the example above, product 4210B sold 4 units (so I need 67% to the right) and 4210C sold 2 units (so I need 33% to the right), leaving the percent of total blank next to the sum. Here is what it should look like after code runs:

    P/N Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec Total %tot
    4210B 0 0 20 41 42 38 51 35 38 55 52 48 420 79%
    4210C 0 5 10 10 10 15 10 15 10 5 10 15 115 21%
    0 5 30 51 62 53 61 50 48 60 62 63 535

    4260B 1 5 4 10 8 5 7 5 3 2 5 5 60 14%
    4260C 20 20 20 20 20 20 20 20 20 20 20 20 240 57%
    4260D 10 10 10 10 10 10 10 10 10 10 10 10 120 29%
    31 35 34 40 38 35 37 35 33 32 35 35 420

    4277B 5 5 5 5 5 5 5 5 5 5 5 5 60 83%
    4277C 1 1 1 1 1 1 1 1 1 1 1 1 12 17%
    6 6 6 6 6 6 6 6 6 6 6 6 72

    Since the number of rows is not constant, how do I devide the product sum (variable within the series) by the product group sum (constant within the series) when the size of the array is not constant?
    Last edited by CodeMakr; 12-07-2006 at 12:22 PM.

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Can you post a workbook containing your sample data.
    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'

  3. #3
    VBAX Regular
    Joined
    Dec 2006
    Posts
    69
    Location

    Formula in moving array

    Here is the sample spreadsheet. I have the code for adding the blank rows in between and the sums, but the percent of total column (P) calculation is giving me trouble (i.e., the code to devide the number to the right (variable per group) with the total of that particular group(static per group)).

    Any help is greatly appreciated

  4. #4
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    [vba]
    Option Explicit
    Sub TotalsAndPercentages()
    Dim Fcel As Range, rngParts As Range
    Dim Rw As Long

    Set Fcel = ActiveCell
    'Set range as list of parts
    Set rngParts = Range(Fcel.Offset(-1).End(xlUp), Fcel.Offset(-1))
    'Get number of first row
    Rw = Fcel.End(xlUp).Row
    'Insert 2 rows; reset Fcel to Totals row
    Fcel.Resize(2, 19).Insert
    Set Fcel = Fcel.Offset(-2)
    'Add border
    With Fcel.Resize(, 19).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    'Write totals formulae
    Fcel.Offset(, 2).Resize(, 13).FormulaR1C1 = "=SUM(R" & Rw & "C:R[-1]C)"
    'Format cells and write percentange formulae
    With rngParts.Offset(, 15)
    .Style = "Percent"
    .Interior.ColorIndex = 6
    .Font.ColorIndex = 3
    .FormulaR1C1 = "=RC[-1]/R" & Fcel.Row & "C[-1]"
    End With
    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'

  5. #5
    VBAX Regular
    Joined
    Dec 2006
    Posts
    69
    Location
    Thank you very much!! That works perfectly. This forum, and your participation, are an abosolutely fabulous resource. You have saved me hours of =)

    I appreciate your time and effort

Posting Permissions

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