Thread: VBA Linear Interpolation

Hi All

I have a quarterly US GDP data from 1980 to date. The problem I have is given the data is only produced quarterly I have gaps in the data. This is fine when drawing a chart in excel as you can simply join data points however, an external provider I use to publish charts does not have this feature on its software and I am required to provide a value for every date. I therefore need to interpolate (linear) the values between data points. This is easily done manually on a small data set however I wonder if anyone has a piece of VBA code to speed things up.

Thanks

There's one value for GDP, which makes it a little hard to see what you want interpolated.

EDIT: Never mind, I see it ...

You want GDP for every day?? That's kind of empty magnification, isn't it?

I used AutoFilter to extract the quarterly numbers, and a UDF to do the interpolation:

       ----A----- -B-- C ----D----- --E---
   1   Date       GDP    Date       GDP   
   2   09/30/1980 -0.7   09/30/1980 -0.700
   3   12/31/1980  7.6   10/01/1980 -0.610
   4   03/31/1981  8.6   10/02/1980 -0.520
   5   06/30/1981 -3.2   10/03/1980 -0.429
   6   09/30/1981  4.9   10/04/1980 -0.339
   7   12/31/1981 -4.9   10/05/1980 -0.249
   8   03/31/1982 -6.4   10/06/1980 -0.159
   9   06/30/1982  2.2   10/07/1980 -0.068
  10   09/30/1982 -1.5   10/08/1980  0.022
  11   12/31/1982  0.3   10/09/1980  0.112
  12   03/31/1983  5.1   10/10/1980  0.202

The formula in E2 and down is

=LINTERP(D2, $A$2:$A$121, $B$2:$B$121)

Here's the UDF:

Private Function Frac(d As Double, r As Range, _
                       ByRef i As Long, ByRef dF As Double, _
                       iMatchType As Long)
    ' shg 1997-0606, 2009-0419
    '     2009-0604 added option for descending sort

    ' Returns an index to r in i and an interpolation fraction in dF
    ' r must be a 2+ element vector sorted {a|de}scending if iMatchType={1|-1}

    If iMatchType = 1 And d <= r(1).Value2 Or _
       iMatchType = -1 And d >= r(1).Value2 Then
        i = 1
    Else
        ' this can generate an error, handled by caller
        i = WorksheetFunction.Match(d, r.Value2, iMatchType)
        If i = r.Count Then i = r.Count - 1
    End If

    dF = (d - r(i).Value2) / (r(i + 1).Value2 - r(i).Value2)
End Function

Function LINTERP(x As Double, rX As Range, rY As Range) As Variant

    ' shg 1997-0606, 2009-0419
    '     2009-0604 added option for descending sort

    ' Linear interpolator / extrapolator
    ' {Inter|extra}polates rX to return the value of y corresponding to the given x

    ' rX and rY must be equal-length vectors
    ' rX must be sorted (ascending or descending, doesn't matter)

    Dim i           As Long     ' index to rY
    Dim dF          As Double   ' interpolation fraction

    If rX.Areas.Count > 1 Then GoTo Oops
    If rX.Rows.Count <> 1 And rX.Columns.Count <> 1 Then GoTo Oops
    If WorksheetFunction.Count(rX) <> rX.Count Then GoTo Oops

    If rY.Areas.Count > 1 Then GoTo Oops
    If rY.Rows.Count <> 1 And rY.Columns.Count <> 1 Then GoTo Oops
    If WorksheetFunction.Count(rY) <> rY.Count Then GoTo Oops

    If rX.Count < 2 Then GoTo Oops
    If rX.Count <> rY.Count Then GoTo Oops

    On Error GoTo Oops ' Frac can error
    
    Frac x, rX, i, dF, IIf(rX(rX.Count).Value2 > rX(1).Value2, 1, -1)
    LINTERP = rY(i).Value2 * (1 - dF) + rY(i + 1).Value2 * dF
    Exit Function

Oops:
    LINTERP = CVErr(xlErrValue)
End Function