PDA

View Full Version : Solved: Formula in moving array



CodeMakr
12-07-2006, 12:02 PM
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:

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


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?

mdmackillop
12-07-2006, 02:26 PM
Can you post a workbook containing your sample data.

CodeMakr
12-08-2006, 08:21 AM
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 :help

mdmackillop
12-08-2006, 03:17 PM
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

CodeMakr
12-08-2006, 04:47 PM
Thank you very much!! That works perfectly. This forum, and your participation, are an abosolutely fabulous resource. You have saved me hours of :banghead: =)

I appreciate your time and effort :bow: