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