Out at a client I had issues with their forecasting system. They use a decomposition system, which means that you take the historic actuals over time and:
 | Work out the seasonality |
| Take out the seasonality |
| Do a best-fit line on the unseasonalised data |
| Apply the seasonality onto the best-fit line |
The problem is, you don't always get the result you want - sometimes the best-fit is just too steep, and you know it will plateau. Or indeed it may be plateauing now, but the best fit misses this. Ultimately you need some way for the user to apply some kind of subjective 'fudge factor'.
I came up with a weighted linear regression UDF. This works like SLOPE, INTERCEPT and LINEST, but has an extra input range for the weighting. The code is below.
There is also a sample spreadsheet showing its use here WLR.xls - this includes the code for the function, of course.
The problem with weighted linear regression is how to weight things. As it turned out, we decided that this was actually a fundamental problem with the data we had. We could allow the user to select a 'recent data'-biased weighting, but where's the integrity in that?
So then I started experimenting with an explicit 'tilt' that the user can apply. This means you can make the forecasts look like whatever you want, but any fudge you apply is totally explicit, so readers would see that a fudge has been applied. But that's another story, here is the WLR code for you to use if you like.
Function WLRIntercept(YRange As Range, XRange As Range, WeightRange As Range)
'calculates the weighted linear regression - intercept
'by Adam Slim
Dim SigmaW As Double, SigmaWX As Double, SigmaWX2 As Double
Dim SigmaWY As Double, SigmaWXY As Double
Dim i As Long
'validate ranges
If XRange.Count <> YRange.Count Or XRange.Count <> WeightRange.Count Then
'fails - the ranges must be the same size
WLRIntercept = CVErr(xlErrRef)
Exit Function
End If
'calculate the sigmas
For i = 1 To XRange.Count
SigmaW = SigmaW + WeightRange.Cells(i).Value
SigmaWX = SigmaWX + WeightRange.Cells(i).Value * XRange.Cells(i).Value
SigmaWX2 = SigmaWX2 + WeightRange.Cells(i).Value * XRange.Cells(i).Value ^ 2
SigmaWY = SigmaWY + WeightRange.Cells(i).Value * YRange.Cells(i).Value
SigmaWXY = SigmaWXY + WeightRange.Cells(i).Value * XRange.Cells(i).Value * YRange.Cells(i).Value
Next i
'calculate the outputs
WLRIntercept = (SigmaWX2 * SigmaWY - SigmaWX * SigmaWXY) / (SigmaW * SigmaWX2 - SigmaWX ^ 2)
End Function
Function WLRSlope(YRange As Range, XRange As Range, WeightRange As Range)
'calculates the weighted linear regression - slope
'by Adam Slim
Dim SigmaW As Double, SigmaWX As Double, SigmaWX2 As Double
Dim SigmaWY As Double, SigmaWXY As Double
Dim i As Long
'validate ranges
If XRange.Count <> YRange.Count Or XRange.Count <> WeightRange.Count Then
'fails - the ranges must be the same size
WLRSlope = CVErr(xlErrRef)
Exit Function
End If
'calculate the sigmas
For i = 1 To XRange.Count
SigmaW = SigmaW + WeightRange.Cells(i).Value
SigmaWX = SigmaWX + WeightRange.Cells(i).Value * XRange.Cells(i).Value
SigmaWX2 = SigmaWX2 + WeightRange.Cells(i).Value * XRange.Cells(i).Value ^ 2
SigmaWY = SigmaWY + WeightRange.Cells(i).Value * YRange.Cells(i).Value
SigmaWXY = SigmaWXY + WeightRange.Cells(i).Value * XRange.Cells(i).Value * YRange.Cells(i).Value
Next i
'calculate the outputs
WLRSlope = (SigmaW * SigmaWXY - SigmaWX * SigmaWY) / (SigmaW * SigmaWX2 - SigmaWX ^ 2)
End Function
Function WLR(YRange As Range, XRange As Range, WeightRange As Range)
'calculates the weighted linear regression - returns an array {a,b} {slope,intercept}
'by Adam Slim
Dim SigmaW As Double, SigmaWX As Double, SigmaWX2 As Double
Dim SigmaWY As Double, SigmaWXY As Double
Dim i As Long, outWLR(1 To 2) As Double
'validate ranges
If XRange.Count <> YRange.Count Or XRange.Count <> WeightRange.Count Then
'fails - the ranges must be the same size
WLR = CVErr(xlErrRef)
Exit Function
End If
'calculate the sigmas
For i = 1 To XRange.Count
SigmaW = SigmaW + WeightRange.Cells(i).Value
SigmaWX = SigmaWX + WeightRange.Cells(i).Value * XRange.Cells(i).Value
SigmaWX2 = SigmaWX2 + WeightRange.Cells(i).Value * XRange.Cells(i).Value ^ 2
SigmaWY = SigmaWY + WeightRange.Cells(i).Value * YRange.Cells(i).Value
SigmaWXY = SigmaWXY + WeightRange.Cells(i).Value * XRange.Cells(i).Value * YRange.Cells(i).Value
Next i
'calculate the outputs
outWLR(1) = (SigmaWX2 * SigmaWY - SigmaWX * SigmaWXY) / (SigmaW * SigmaWX2 - SigmaWX ^ 2)
outWLR(2) = (SigmaW * SigmaWXY - SigmaWX * SigmaWY) / (SigmaW * SigmaWX2 - SigmaWX ^ 2)
WLR = outWLR
End Function