Macro To Calculate Percentage Allocation

1 Attachment(s)

I have attached a spreadsheet. I have a macro that totals the values.

I need a macro that will put text ""% allocation" in Col A 6 rows below the values and compute each total by a % based on the ageing. For eg the total in Col C (30 days +) must be multiplied by K2, the total for Col D must be multiplied by K3 etc

The data is impoted so the dataset changes all the time, but K2 to K5 are absolute

I have manually computed these (see C63 to F63)

Your assistance in writing the code will be most appreciated

Quote:

Originally Posted by Howardc

I have attached a spreadsheet. I have a macro that totals the values.

I need a macro that will put text ""% allocation" in Col A 6 rows below the values and compute each total by a % based on the ageing. For eg the total in Col C (30 days +) must be multiplied by K2, the total for Col D must be multiplied by K3 etc

The data is impoted so the dataset changes all the time, but K2 to K5 are absolute

I have manually computed these (see C63 to F63)

Your assistance in writing the code will be most appreciated

'If you want the rest of the formula to work and assign Allocation %
'Just remove the Oppostrafy from the front of each line and move the "End Sub"
'to the bottom.

Code:

Sub Add_Totals() FinalRow = Cells(Rows.Count, 1).End(xlUp).Row - 1 'FinalRow is equal to ===== Cells. Range("A" & FinalRow).ClearContents 'Why "-1" ? Why the last row in your DataSet??? Range("B" & FinalRow).ClearContents 'Definately, changes the total of Col "B"... by 15117.73 Range("C" & FinalRow).ClearContents Range("D" & FinalRow).ClearContents Range("E" & FinalRow).ClearContents Range("F" & FinalRow).ClearContents FinalRow = Cells(Rows.Count, 1).End(xlUp).Row Range("A" & FinalRow).ClearContents Range("B" & FinalRow).ClearContents 'FinalRow = Range("A65536").End(xlUp).Row + 2 Range("A" & FinalRow + 2).Value = "Total" Range("B" & FinalRow + 2).FORMULA = "=sum(B6:B" & FinalRow & ")" Range("C" & FinalRow + 2).FORMULA = "=sum(C6:C" & FinalRow & ")" Range("D" & FinalRow + 2).FORMULA = "=sum(D6:D" & FinalRow & ")" Range("E" & FinalRow + 2).FORMULA = "=sum(E6:E" & FinalRow & ")" Range("F" & FinalRow + 2).FORMULA = "=sum(F6:F" & FinalRow & ")" FinalRow = Cells(Rows.Count, 1).End(xlUp).Row i = 8 For i = 6 To FinalRow With i Cells(i, 2).NumberFormat = "#,##0.00;(#,##0.00)" Cells(i, 3).NumberFormat = "#,##0.00;(#,##0.00)" Cells(i, 4).NumberFormat = "#,##0.00;(#,##0.00)" Cells(i, 5).NumberFormat = "#,##0.00;(#,##0.00)" Cells(i, 6).NumberFormat = "#,##0.00;(#,##0.00)" End With Next i End Sub COPY TO YOUR MACRO (TEST FIRST....) 'Range("A" & FinalRow + 4) = "% Allocation" 'FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 'i = FinalRow 'With i 'Cells(i, 3).FormulaR1C1 = "=R[-4]C*R2C11" 'Cells(i, 3).NumberFormat = "#,##0.00;(#,##0.00)" 'Cells(i, 4).FormulaR1C1 = "=R[-4]C*R3C11" 'Cells(i, 4).NumberFormat = "#,##0.00;(#,##0.00)" 'Cells(i, 5).FormulaR1C1 = "=R[-4]C*R4C11" 'Cells(i, 5).NumberFormat = "#,##0.00;(#,##0.00)" 'Cells(i, 6).FormulaR1C1 = "=R[-4]C*R5C11" 'Cells(i, 6).NumberFormat = "#,##0.00;(#,##0.00)" 'End With

Hi bsmill,

Welcome to ExcelFox!!

Please use code tag while posting codes. :)

Thanks for the help, much appreciated