Producing hundreds of Multiple Regression analysis scenarios simultaneously

[Paul_Hossler]

This macro will add the TREND() formulas in your block of data in the predicted column

Not 100% bullet proof

Option Explicit
Const colKnownY As String = "E:E"       '   exactly 3 char
Const colKnownXs As String = "F:H"      '   exactly 3 char

Sub AddTrendFormulas()
    Dim rData As Range, rTrend As Range, rData1 As Range
    Dim sFormula As String
    Dim rowStart As Long, rowEnd As Long, i As Long
    Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
    Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
    'delete formulas in Y's
    On Error Resume Next
    Set rTrend = rData.Range(colKnownY).SpecialCells(xlCellTypeFormulas)
    rTrend.ClearContents
    Set rTrend = Intersect(rData, ActiveSheet.Range(colKnownY)).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    'check to see if areas are same size
    For i = 1 To rTrend.Areas.Count - 1
        If rTrend.Areas(i).Rows.Count <> rTrend.Areas(i + 1).Rows.Count Then
            MsgBox "Not all blocks are the same size"
            Exit Sub
        End If
    Next i
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    'sort by country, role, year
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rData1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rData1.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rData
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'build formula using first block as template
    '=TREND(E2:E13,F2:H13,F14:H26)
    sFormula = "=TREND("
    
    With rTrend.Areas(1)
        rowStart = 2
        rowEnd = .Cells(1, 1).Row - 1
    
        sFormula = sFormula & Left(colKnownY, 1) & rowStart & ":" & Left(colKnownY, 1) & rowEnd & ","
        sFormula = sFormula & Left(colKnownXs, 1) & rowStart & ":" & Right(colKnownXs, 1) & rowEnd & ","
        
        rowStart = .Cells(1, 1).Row
        rowEnd = .Cells(.Rows.Count, 1).Row
        sFormula = sFormula & Left(colKnownXs, 1) & rowStart & ":" & Right(colKnownXs, 1) & rowEnd & ")"
    
        .FormulaArray = sFormula
        
        .Copy
    End With

    'paste formulas from first area to other areas
    For i = 2 To rTrend.Areas.Count
        rTrend.Areas(i).Select
        ActiveSheet.Paste
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Done"

End Sub