how to make a macro shorter using for next

Viewed 108

Please can you help me to make my macro shorter using a loop. This is the coefficient trend line applied to my dynamic array at B2:G - xlend.

Sub TESTONE()
'||||||||||||||||||||||||||||||||||||||||||||||||| LINE B |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Range("I3").Formula = "=FORECAST(18,B3:B19,$A$3:$A$19)"
Range("I4").Formula = "=TREND(B3:B19)"
Range("I5").Formula = "=INTERCEPT(B3:B19,$A$3:$A$19)"
Range("I6").Formula = "=INDEX(LINEST(B3:B19,LN($A$3:$A$19)),1,2)"
Range("I7").Formula = "=EXP(INDEX(LINEST(LN(B3:B19),LN($A$3:$A$19),,),1,2))"
Range("I8").Formula = "=EXP(INDEX(LINEST(LN(B3:B19),$A$3:$A$19),1,2))"
Range("I9").Formula = "=INDEX(LINEST(B3:B19,$A$3:$A$19^{1,2}),1,3)"
Range("I10").Formula = "=INDEX(LINEST(B3:B19,$A$3:$A$19^{1,2,3}),1,4)"

'||||||||||||||||||||||||||||||||||||||||||||||||| LINE C |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Range("J3").Formula = "=FORECAST(18,C3:C19,$A$3:$A$19)"
Range("J4").Formula = "=TREND(C3:C19)"
Range("J5").Formula = "=INTERCEPT(C3:C19,$A$3:$A$19)"
Range("J6").Formula = "=INDEX(LINEST(C3:C19,LN($A$3:$A$19)),1,2)"
Range("J7").Formula = "=EXP(INDEX(LINEST(LN(C3:C19),LN($A$3:$A$19),,),1,2))"
Range("J8").Formula = "=EXP(INDEX(LINEST(LN(C3:C19),$A$3:$A$19),1,2))"
Range("J9").Formula = "=INDEX(LINEST(C3:C19,$A$3:$A$19^{1,2}),1,3)"
Range("J10").Formula = "=INDEX(LINEST(C3:C19,$A$3:$A$19^{1,2,3}),1,4)"


'||||||||||||||||||||||||||||||||||||||||||||||||| LINE D |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Range("K3").Formula = "=FORECAST(18,D3:D19,$A$3:$A$19)"
Range("K4").Formula = "=TREND(D3:D19)"
Range("K5").Formula = "=INTERCEPT(D3:D19,$A$3:$A$19)"
Range("K6").Formula = "=INDEX(LINEST(D3:D19,LN($A$3:$A$19)),1,2)"
Range("K7").Formula = "=EXP(INDEX(LINEST(LN(D3:D19),LN($A$3:$A$19),,),1,2))"
Range("K8").Formula = "=EXP(INDEX(LINEST(LN(D3:D19),$A$3:$A$19),1,2))"
Range("K9").Formula = "=INDEX(LINEST(D3:D19,$A$3:$A$19^{1,2}),1,3)"
Range("K10").Formula = "=INDEX(LINEST(D3:D19,$A$3:$A$19^{1,2,3}),1,4)"


'||||||||||||||||||||||||||||||||||||||||||||||||| LINE E |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Range("L3").Formula = "=FORECAST(18,E3:E19,$A$3:$A$19)"
Range("L4").Formula = "=TREND(E3:E19)"
Range("L5").Formula = "=INTERCEPT(E3:E19,$A$3:$A$19)"
Range("L6").Formula = "=INDEX(LINEST(E3:E19,LN($A$3:$A$19)),1,2)"
Range("L7").Formula = "=EXP(INDEX(LINEST(LN(E3:E19),LN($A$3:$A$19),,),1,2))"
Range("L8").Formula = "=EXP(INDEX(LINEST(LN(E3:E19),$A$3:$A$19),1,2))"
Range("L9").Formula = "=INDEX(LINEST(E3:E19,$A$3:$A$19^{1,2}),1,3)"
Range("L10").Formula = "=INDEX(LINEST(E3:E19,$A$3:$A$19^{1,2,3}),1,4)"


'||||||||||||||||||||||||||||||||||||||||||||||||| LINE F |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Range("M3").Formula = "=FORECAST(18,F3:F19,$A$3:$A$19)"
Range("M4").Formula = "=TREND(F3:F19)"
Range("M5").Formula = "=INTERCEPT(F3:F19,$A$3:$A$19)"
Range("M6").Formula = "=INDEX(LINEST(F3:F19,LN($A$3:$A$19)),1,2)"
Range("M7").Formula = "=EXP(INDEX(LINEST(LN(F3:F19),LN($A$3:$A$19),,),1,2))"
Range("M8").Formula = "=EXP(INDEX(LINEST(LN(F3:F19),$A$3:$A$19),1,2))"
Range("M9").Formula = "=INDEX(LINEST(F3:F19,$A$3:$A$19^{1,2}),1,3)"
Range("M10").Formula = "=INDEX(LINEST(F3:F19,$A$3:$A$19^{1,2,3}),1,4)"


'||||||||||||||||||||||||||||||||||||||||||||||||| LINE G |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Range("N3").Formula = "=FORECAST(18,G3:G19,$A$3:$A$19)"
Range("N4").Formula = "=TREND(G3:G19)"
Range("N5").Formula = "=INTERCEPT(G3:G19,$A$3:$A$19)"
Range("N6").Formula = "=INDEX(LINEST(G3:G19,LN($A$3:$A$19)),1,2)"
Range("N7").Formula = "=EXP(INDEX(LINEST(LN(G3:G19),LN($A$3:$A$19),,),1,2))"
Range("N8").Formula = "=EXP(INDEX(LINEST(LN(G3:G19),$A$3:$A$19),1,2))"
Range("N9").Formula = "=INDEX(LINEST(G3:G19,$A$3:$A$19^{1,2}),1,3)"
Range("N10").Formula = "=INDEX(LINEST(G3:G19,$A$3:$A$19^{1,2,3}),1,4)"

End Sub
5 Answers

Write Formulas in a Loop

Option Explicit

Sub WriteFormulas()
    
    Const fRow As Long = 3
    Const lrCol As String = "A"
    Const Cols As String = "I:N"
    
    With ActiveSheet
        Dim lRow As Long: lRow = .Cells(.Rows.Count, lrCol).End(xlUp).Row
        If lRow < fRow Then Exit Sub
        Dim Formulas() As String: Formulas = GetFormulas(fRow, lRow)
        Dim rrg As Range: Set rrg = .Columns(Cols).Rows(fRow)
        Dim n As Long
        For n = LBound(Formulas) To UBound(Formulas)
            rrg.Formula = Formulas(n)
            Set rrg = rrg.Offset(1)
        Next n
    End With

End Sub

Function GetFormulas( _
    ByVal fRow As Long, _
    ByVal lRow As Long) _
As Variant
    
    Dim Formulas() As String: ReDim Formulas(1 To 8)
    Formulas(1) = "=FORECAST(18,B" & fRow & ":B" & lRow & ",$A$" _
        & fRow & ":$A$" & lRow & ")"
    Formulas(2) = "=TREND(B" & fRow & ":B" & lRow & ")"
    Formulas(3) = "=INTERCEPT(B" & fRow & ":B" & lRow & ",$A$" _
        & fRow & ":$A$" & lRow & ")"
    Formulas(4) = "=INDEX(LINEST(B" & fRow & ":B" & lRow & ",LN($A$" _
        & fRow & ":$A$" & lRow & ")),1,2)"
    Formulas(5) = "=EXP(INDEX(LINEST(LN(B" & fRow & ":B" & lRow _
        & "),LN($A$" & fRow & ":$A$" & lRow & "),,),1,2))"
    Formulas(6) = "=EXP(INDEX(LINEST(LN(B" & fRow & ":B" & lRow _
        & "),$A$" & fRow & ":$A$" & lRow & "),1,2))"
    Formulas(7) = "=INDEX(LINEST(B" & fRow & ":B" & lRow & ",$A$" _
        & fRow & ":$A$" & lRow & "^{1,2}),1,3)"
    Formulas(8) = "=INDEX(LINEST(B" & fRow & ":B" & lRow & ",$A$" _
        & fRow & ":$A$" & lRow & "^{1,2,3}),1,4)"
    GetFormulas = Formulas

End Function

Try this:

Private Sub TestOne()
For j = 66 To 71
    For i = 73 To 78
        Range(Chr(i) & "3").Formula = "=FORECAST(18," & Chr(j) & "3:" & Chr(j) & "19,$A$3:$A$19)"
        Range(Chr(i) & "4").Formula = "=TREND(" & Chr(j) & "3:" & Chr(j) & "19)"
        Range(Chr(i) & "5").Formula = "=INTERCEPT(" & Chr(j) & "3:" & Chr(j) & "19,$A$3:$A$19)"
        Range(Chr(i) & "6").Formula = "=INDEX(LINEST(" & Chr(j) & "3:" & Chr(j) & "19,LN($A$3:$A$19)),1,2)"
        Range(Chr(i) & "7").Formula = "=EXP(INDEX(LINEST(LN(" & Chr(j) & "3:" & Chr(j) & "19),LN($A$3:$A$19),,),1,2))"
        Range(Chr(i) & "8").Formula = "=EXP(INDEX(LINEST(LN(" & Chr(j) & "3:" & Chr(j) & "19),$A$3:$A$19),1,2))"
        Range(Chr(i) & "9").Formula = "=INDEX(LINEST(" & Chr(j) & "3:" & Chr(j) & "19,$A$3:$A$19^{1,2}),1,3)"
        Range(Chr(i) & "10").Formula = "=INDEX(LINEST(" & Chr(j) & "3:" & Chr(j) & "19,$A$3:$A$19^{1,2,3}),1,4)"
    Next
Next End Sub

You could try this one, I created variables like countFormulaColumns and strReferenceRangeAddress simply for readability, they are not 100% necessary if this is just a one-time task.

Sub TESTONE()
    ' Starting from column I, there are 6 consecutive columns having similar formula generated in VBA
    Dim countFormulaColumns As Long: countFormulaColumns = 6

    ' Starting from B3:B19, ends at G3:G19, this string variable represtents all reference addresses in the formula
    Dim strReferenceRangeAddress As String

    Dim colOffset As Long
    For colOffset = 0 To countFormulaColumns - 1
        strReferenceRangeAddress = Range("B3:B19").Offset(0, colOffset).Address(False, False)
        With Range("I3")
            .Offset(0, colOffset).Formula = "=FORECAST(18," & strReferenceRangeAddress & ",$A$3:$A$19)"
            .Offset(1, colOffset).Formula = "=TREND(" & strReferenceRangeAddress & ")"
            .Offset(2, colOffset).Formula = "=INTERCEPT(" & strReferenceRangeAddress & ",$A$3:$A$19)"
            .Offset(3, colOffset).Formula = "=INDEX(LINEST(" & strReferenceRangeAddress & ",LN($A$3:$A$19)),1,2)"
            .Offset(4, colOffset).Formula = "=EXP(INDEX(LINEST(LN(" & strReferenceRangeAddress & "),LN($A$3:$A$19),,),1,2))"
            .Offset(5, colOffset).Formula = "=EXP(INDEX(LINEST(LN(" & strReferenceRangeAddress & "),$A$3:$A$19),1,2))"
            .Offset(6, colOffset).Formula = "=INDEX(LINEST(" & strReferenceRangeAddress & ",$A$3:$A$19^{1,2}),1,3)"
            .Offset(7, colOffset).Formula = "=INDEX(LINEST(" & strReferenceRangeAddress & ",$A$3:$A$19^{1,2,3}),1,4)"
        End With
    Next colOffset
End Sub

Here is one implementation of what @BigBen has suggested in his comment above.

With Range("L3:L10")
    .Cells(1).Formula = "=FORECAST(18,E3:E19,$A$3:$A$19)"
    .Cells(2).Formula = "=TREND(E3:E19)"
    .Cells(3).Formula = "=INTERCEPT(E3:E19,$A$3:$A$19)"
    .Cells(4).Formula = "=INDEX(LINEST(E3:E19,LN($A$3:$A$19)),1,2)"
    .Cells(5).Formula = "=EXP(INDEX(LINEST(LN(E3:E19),LN($A$3:$A$19),,),1,2))"
    .Cells(6).Formula = "=EXP(INDEX(LINEST(LN(E3:E19),$A$3:$A$19),1,2))"
    .Cells(7).Formula = "=INDEX(LINEST(E3:E19,$A$3:$A$19^{1,2}),1,3)"
    .Cells(8).Formula = "=INDEX(LINEST(E3:E19,$A$3:$A$19^{1,2,3}),1,4)"
    .Copy Destination:=.Resize(, 3)
End With

For "smart" formula replication, the way to output an array to a range is handy. Specifically, when you output a one-column vertical array of formulas into a two-dimensional range, Excel automatically shifts the column references

Sub TESTONE()
    Range("I3:N10").Formula = WorksheetFunction.Transpose(Array( _
        "=FORECAST(18,B3:B19,$A$3:$A$19)", _
        "=TREND(B3:B19)", _
        "=INTERCEPT(B3:B19,$A$3:$A$19)", _
        "=INDEX(LINEST(B3:B19,LN($A$3:$A$19)),1,2)", _
        "=EXP(INDEX(LINEST(LN(B3:B19),LN($A$3:$A$19),,),1,2))", _
        "=EXP(INDEX(LINEST(LN(B3:B19),$A$3:$A$19),1,2))", _
        "=INDEX(LINEST(B3:B19,$A$3:$A$19^{1,2}),1,3)", _
        "=INDEX(LINEST(B3:B19,$A$3:$A$19^{1,2,3}),1,4)"))
End Sub

A clear example with one-column vertical array of formulas:

Sub FormulasFromArray()
    Range("A1:D4") = WorksheetFunction.Transpose(Array("=A10", "=A10", "=A10", "=A10"))
End Sub

enter image description here

The same happens with a horizontal array, but the references to the rows are shifted

Sub FormulasFromArrayHorizontal()
    Range("A1:D4") = Array("=A10", "=A10", "=A10", "=A10")
End Sub

enter image description here

Related