locked
Write formula column per column instead of row per row RRS feed

  • Question

  • Hello, I'm a French student and i currently want to optimize a block of code

    I'm using Excel 2016 on a windows 10 computeur.

    my block of code write formula within cells, where the formula has excel sheets as variable

    My excel sheets have their name as : "1", "2", "3" etc.... in an ascending order. My issue is that it write all formula row per row, which is innefficient and time consuming. Is there any way to improve it? like writting a whole culumn at once?

    Here is my block of code ! 

    Sub setformulav1()
    For i = 1 To Worksheets.Count - 5
        'Call CellFormat(i)
        'Copy du format
        If i > 1 Then
        ActiveWorkbook.Sheets("Action Plan Form").Range("A13:CA13").Copy
        ActiveWorkbook.Sheets("Action Plan Form").Range("A" + CStr(12 + i) + ":CA" + CStr(12 + i)).PasteSpecial Paste:=xlPasteAll
        ActiveWorkbook.Sheets("Action Plan Form").Range("A" + CStr(12 + i) + ":CA" + CStr(12 + i)).Borders.LineStyle = xlcontinious
        ActiveWorkbook.Sheets("Action Plan Form").Range("A" + CStr(12 + i) + ":CA" + CStr(12 + i)).Borders.Weight = xlThin
        End If
        ActiveWorkbook.Sheets("Action Plan Form").Rows(12 + i).RowHeight = 180
        'Mise en place des formules:
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, 1).Value = CStr(i)
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, 3).Formula = "=" + CStr(i) + "!$A$9"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "M").Formula = "=" + CStr(i) + "!$A$16"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "AF").Formula = "=" + CStr(i) + "!$B$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "AG").Formula = "=" + CStr(i) + "!$F$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "AH").Formula = "=" + CStr(i) + "!$I$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "AI").Formula = "=" + CStr(i) + "!$L$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "AJ").Formula = "=INDEX($CD$2:$CH$6,CC" + CStr(12 + i) + ",CE" + CStr(12 + i) + ")"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "AK").Formula = "=" + CStr(i) + "!$T$16"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BE").Formula = "=" + CStr(i) + "!$Z$69"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BK").Formula = "=" + CStr(i) + "!$F$69"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BO").Formula = "=" + CStr(i) + "!$F$72"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BS").Formula = "=" + CStr(i) + "!$Z$72"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BW").Formula = "=" + CStr(i) + "!$U$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BX").Formula = "=" + CStr(i) + "!$Y$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BY").Formula = "=" + CStr(i) + "!$AB$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "BZ").Formula = "=" + CStr(i) + "!$AE$41"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CA").Formula = "=INDEX($CD$2:$CH$6,CF" + CStr(12 + i) + ",CH" + CStr(12 + i) + ")"
        'Mise en place des formules de cellules cachées
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CC").Formula = "=IF(AF" + CStr(12 + i) + "=" + Chr(34) + "I" + Chr(34) + ",5,IF(AF" + CStr(12 + i) + "=" + Chr(34) + "II" + Chr(34) + ",4,IF(AF" + CStr(12 + i) + "=" + Chr(34) + "III" + Chr(34) + ",3,IF(AF" + CStr(12 + i) + "=" + Chr(34) + "IV" + Chr(34) + ",2,IF(AF" + CStr(12 + i) + "=" + Chr(34) + "V" + Chr(34) + ",1," + Chr(34) + Chr(34) + ")))))"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CD").Formula = "=AG" + CStr(12 + i) + "+AH" + CStr(12 + i) + "*2+AI" + CStr(12 + i)
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CE").Formula = "=IF(CD" + CStr(12 + i) + "<=10,1, IF(CD" + CStr(12 + i) + "<14,2,IF(CD" + CStr(12 + i) + "<17,3,SI(CD" + CStr(12 + i) + "<19,4,5))))"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CF").Formula = "=IF(BW" + CStr(12 + i) + "=" + Chr(34) + "I" + Chr(34) + ",5,IF(BW" + CStr(12 + i) + "=" + Chr(34) + "II" + Chr(34) + ",4,IF(BW" + CStr(12 + i) + "=" + Chr(34) + "III" + Chr(34) + ",3,IF(BW" + CStr(12 + i) + "=" + Chr(34) + "IV" + Chr(34) + ",2,IF(BW" + CStr(12 + i) + "=" + Chr(34) + "V" + Chr(34) + ",1," + Chr(34) + Chr(34) + ")))))"
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CG").Formula = "=BX" + CStr(12 + i) + "+BY" + CStr(12 + i) + "*2+BZ" + CStr(12 + i)
        ActiveWorkbook.Sheets("Action Plan Form").Cells(12 + i, "CH").Formula = "=IF(CG" + CStr(12 + i) + "<=10,1, IF(CG" + CStr(12 + i) + "<14,2,IF(CG" + CStr(12 + i) + "<17,3,IF(CG" + CStr(12 + i) + "<19,4,5))))"
        Next
    End Sub

    Thank you very much

    Ungoro 


    • Edited by Ungoro Monday, December 25, 2017 4:45 PM
    Monday, December 25, 2017 4:44 PM

All replies

  • Well, we can optimize the code, but the bottleneck is not the code itself.

    The consequences caused by the code are time consuming, I guess most time is spend on formula calculation.

    Therefore we can switch some things off at the start

      Application.Calculation = xlCalculationManual
      Application.EnableEvents = False
      Application.ScreenUpdating = False
    and on at the end
      Application.Calculation = xlCalculationAutomatic
      Application.EnableEvents = True
    

    BTW, your code contains an error. Place the line "Option Explicit" at the top of the module and click "Debug\Compile"


    The 1st error is an undeclared variable, add "Dim i As Long". The 2nd is based on a typo.

    If you use a WITH statement you can optimize the code, because building a reference needs time (but in your case you can speed up only a few milliseconds). Add
      With Sheets("Action Plan Form")
    before the FOR loop and
      End With
    afterwards. After that you can remove all
      ActiveWorkbook.Sheets("Action Plan Form")

    The way you construct your formulas is terrible, if you need to make a change in any formula (later) you have a big problem. Below is a code how to make it better.

    Andreas.

    Tuesday, December 26, 2017 8:08 AM
  • Sub Example_HowToCreateAFormulaWithVBA()
      'Copy the formula from Excel as is
      '  =INDEX(C1:C2,MATCH($A$1,B1:B2,0))&"Whatever"
      'double each " sign inside:
      '  =INDEX(C1:C2,MATCH($A$1,B1:B2,0))&""Whatever""
      'surround the whole formula with " signs
      '  "=INDEX(C1:C2,MATCH($A$1,B1:B2,0))&""Whatever"""
      'Replace the cell references with a "placeholder" (any unique string that you like and doesn't exists elsewhere)
      '  "=INDEX(#C#,MATCH(#A#,#B#,0))&""Whatever"""
      'and assign to a string:
      Dim MyDefFormula As String
      MyDefFormula = "=INDEX(#C#,MATCH(#A#,#B#,0))&""Whatever"""
        
      'Now create the Range objects and refer to the real cells
      Dim A As Range, B As Range, C As Range
      Set A = Range("A1")                                    'A single cell
      Set B = Range("B2:B50")                                'Multiple cells
      Set C = Range("C2", Range("C" & Rows.Count).End(xlUp)) 'From C2 to last used cell in column C
      'Note:
      '  You can refer to cells in an other sheet (note the dot in front of Range!):
      'With Worksheets("That")
      '  Set C = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
      'End With
      '  Or other already opened files:
      'With Workbooks("This.xlsx").Worksheets("That")
      '  Set C = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
      'End With
      
      'Make a copy of your default formula into a work string
      Dim MyFormula As String
      MyFormula = MyDefFormula
      'Replace the placeholders with the cell references
      MyFormula = Replace(MyFormula, "#A#", A.Address)
      'Note:
      '  The first arguments of Range.Address controls where the $ appears in the formula
      MyFormula = Replace(MyFormula, "#B#", B.Address(0, 0))
      'Note:
      '  The part 'External:=True' is necessary if you refer to other sheets or files
      '  But it works also if the reference is in the active sheet
      MyFormula = Replace(MyFormula, "#C#", C.Address(External:=True))
      
      'Write the formula into the cell
      Range("A2").Formula = MyFormula
      
      'Note:
      '  If your locale language is not English you can use the FormulaLocal property instead
      '  But in this case the code works only on PCs with your locale settings
      'Range("A2").FormulaLocal = MyFormula
      
      'Note:
      '  If you want to create array formulas use the FormulaArray property
      '  But in this case use must use English formulas, a FormulaArrayLocale doesn't exists
      'Range("A2:A10").FormulaArray = MyFormula
    End Sub


    Tuesday, December 26, 2017 8:09 AM