Annual to Monthly macro

Question

I am trying to make a formula that runs on a group of cells selected by the find function. Starting at Bdgt FY21. The Purpose of the formula is toconvert from annual to monthly and add a sum formula;

Move one column to the right of the starting point, copy the cell value, and then basically inputs one 12th of that value in the adjacent 12 columns (Annual to monthly). The formula then needs to paste these figures as values, jump back to the annual figure, delete it, and replace with a sum formula. Note I can’t use active cell as that wont allow me to run the code on multiple selected cells

Code below (not the….. is the other months which I have left out to shorten the post). Code clearly isn’t working;

Sub A_MONTHLY()

    cell.Offset(0, 2)"=RC[-1]/12"
    cell.Offset(0, 2).NumberFormat = "#,##0_);(#,##0);"

    cell.Offset(0, 3) "=RC[-2]/12"
    cell.Offset(0, 3).NumberFormat = "#,##0_);(#,##0);"

    cell.Offset(0, 4) "=RC[-3]/12"
    cell.Offset(0, 4).NumberFormat = "#,##0_);(#,##0);"

    .......

    cell.Offset(0, 13) "=RC[-3]/12"
    cell.Offset(0, 13).NumberFormat = "#,##0_);(#,##0);"

    cell.Offset(0, 2).range("A1:L1").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    cell.Offset(0, -1).range("A1").Select
    Application.CutCopyMode = False
    Selection.ClearContents

    cell.FormulaR1C1 = "=SUM(RC[1]:RC[12])"

End Sub

Please note that *"isn’t working"* is no error description. Also I think screenshots how it looks before the macro and how it should look after the macro might help a lot to understand what you are trying to achieve. And I recommend [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Pᴇʜ, Nov 22 '18 at 08:23

dotvihar · Answer 1 · 2018-11-22T14:04:47.513

You should determine the range you want to handle, than in a with section set the formula and the format. Like this:

Dim rng As Range
Set rng = ActiveWorkbook.Worksheets(1).Range("b1:b10")
'update "b1:b10" to your range in parentheses and update worksheets property if necessary

With rng
    .Offset(0, 2).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 2).FormulaR1C1 = "= R[0]C[-1]/12"
    .Offset(0, 3).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 3).FormulaR1C1 = "= R[0]C[-2]/12"
    .Offset(0, 4).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 4).FormulaR1C1 = "= R[0]C[-3]/12"
    .Offset(0, 5).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 5).FormulaR1C1 = "= R[0]C[-4]/12"
    .Offset(0, 6).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 6).FormulaR1C1 = "= R[0]C[-5]/12"
    .Offset(0, 7).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 7).FormulaR1C1 = "= R[0]C[-6]/12"
    .Offset(0, 8).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 8).FormulaR1C1 = "= R[0]C[-7]/12"
    .Offset(0, 9).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 9).FormulaR1C1 = "= R[0]C[-8]/12"
    .Offset(0, 10).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 10).FormulaR1C1 = "= R[0]C[-9]/12"
    .Offset(0, 11).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 11).FormulaR1C1 = "= R[0]C[-10]/12"
    .Offset(0, 12).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 12).FormulaR1C1 = "= R[0]C[-11]/12"
    .Offset(0, 13).NumberFormat = "#.##0_);(#.##0);"
    .Offset(0, 13).FormulaR1C1 = "= R[0]C[-12]/12"
End With

I suggest you to change the order. At first set the cell format, then enter its value.

The rest of the code can be built as above.

For Excel it dosn't make any difference if you first use `.NumberFormat` and then `.FormulaR1C1` or the other way round. I don't see why this should help. — Pᴇʜ, Nov 22 '18 at 14:44
I tried it a text formatted range and the formula inserted as text not as ots results. — dotvihar, Nov 22 '18 at 14:54
Ah well my bad, in this case it makes totally sense! Of course I assumed the cells to be in the default number format "General" . — Pᴇʜ, Nov 22 '18 at 15:11

Pᴇʜ · Accepted Answer · 2018-11-23T07:08:31.600

Use a loop to loop through all rows of your selected area:

Public Sub AnnualToMonthly()
    If Selection.Columns.Count > 1 Then Exit Sub

    Dim iCell As Range
    For Each iCell In Selection
        With iCell.Offset(ColumnOffset:=1).Resize(ColumnSize:=12)
            .Value = iCell.Value / 12
            .NumberFormat = "#,##0_);(#,##0);"
            iCell.FormulaR1C1 = "=SUM(RC[1]:RC[12])" 'Alternatively iCell.Formula = "=SUM(" & .Address(False, False) & ")"
        End With
    Next iCell
End Sub

Just select a range in your column TOTAL and run it.

A even faster alternative would be reading the data into an array, divide all values by 12 and write it back at once:

Public Sub AnnualToMonthly2()
    Dim SelRange As Range
    Set SelRange = Selection

    If SelRange.Columns.Count > 1 Then Exit Sub

    Dim ValArr As Variant
    ValArr = SelRange.Value 'read all values into array

    If SelRange.Rows.Count > 1 Then
        Dim i As Long
        For i = LBound(ValArr) To UBound(ValArr)
            ValArr(i, 1) = ValArr(i, 1) / 12 'divide all values by 12
        Next i
    Else
        ValArr = ValArr / 12
    End If

    'write divided values back (very fast)
    With SelRange.Offset(ColumnOffset:=1).Resize(ColumnSize:=12)
        .Value = ValArr
        .NumberFormat = "#,##0_);(#,##0);"
    End With

    'write formula for total sum
    SelRange.FormulaR1C1 = "=SUM(RC[1]:RC[12])"
End Sub

This way you have only one read action for the data and one write action for the data. This should be faster than writing it row by row in a loop.

I just get an error 13 at the line For i = LBound(ValArr) To UBound(ValArr) — Scottyp, Nov 22 '18 at 22:23
@Scottyp This happened if you selected only one cell. I fixed it, so it works if you select one or multiple continuous cells. See my edited answer. — Pᴇʜ, Nov 23 '18 at 07:09

Annual to Monthly macro

2 Answers2