Tukukkk

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

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.

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.