Loading...

1D Linear Interpolation & Extrapolation in VBA

Here we provide the sample code for two equivalent methods for performing 1D linear interpolation and extrapolation in Excel/VBA.

The first, 'standard' method uses the approach found in most resources, e.g. Wikipedia. The second method computes the equation of the line in the relevant segment [(x0, y0), (x1, y1)] then evaluates the equation at the desired query point.

Standard Method

                    
Private Function interp1D(ByVal x As Variant, ByVal y As Variant, ByVal xi As Variant, Optional ByVal extrapolate As Boolean = False) As Variant
    ' Performs 1D linear interpolation, with optional linear extrapolation.
    
    ' Inputs:
    ' x - 1D array of independent variable sample points.
    ' y - 1D array of corresponding values.
    ' xi - 1D array of query points.
    ' extrapolate - Boolean flag for linear extrapolation.
    
    ' Output:
    ' A 1D array of interpolated/extrapolated values, with the same dimensions as xi.
    
    Dim n As Long, ni As Long
    Dim yi() As Variant
    
    ' Verify that x and y have equal number of elements.
    If UBound(x) <> UBound(y) Then
        interp1D = CVErr(xlErrValue)
        Exit Function
    End If
    
    ' Get max dims.
    n = UBound(x)
    ni = UBound(xi)
    
    ' Initialise output array.
    ReDim yi(1 To ni)
    
    ' Loop over query points and interpolate/extrapolate.
    For i = 1 To ni
        If xi(i) < x(1) Then
            If extrapolate Then
                ' How I think about extrapolation off the left-hand end of a range.
                yi(i) = y(1) + (xi(i) - x(1)) * ((y(2) - y(1)) / (x(2) - x(1)))
            Else
                yi(i) = CVErr(xlErrNA)
            End If
        ElseIf xi(i) >= x(1) And xi(i) <= x(n) Then
            ' Interpolate.
            For j = 1 To n - 1
                If xi(i) >= x(j) And xi(i) <= x(j + 1) Then
                    ' How I think about interpolation.
                    yi(i) = y(j) + (xi(i) - x(j)) * ((y(j + 1) - y(j)) / (x(j + 1) - x(j)))
                    Exit For
                End If
            Next j
        Else
            If extrapolate Then
                ' How I think about extrapolation off the right-hand end of a range.
                yi(i) = y(n) + (xi(i) - x(n)) * ((y(n) - y(n - 1)) / (x(n) - x(n - 1)))
            Else
                yi(i) = CVErr(xlErrNA)
            End If
        End If
    Next i
    
    interp1D = yi
End Function


Private Function rowRangeToArray(rng As Range) As Variant
    Dim data() As Variant
    Dim i As Long
    
    ReDim data(1 To rng.Columns.Count)
    
    For i = 1 To rng.Columns.Count
        data(i) = rng(1, i).Value
    Next i
    
    rowRangeToArray = data
End Function

Private Function colRangeToArray(rng As Range) As Variant
    Dim data() As Variant
    Dim i As Long
    
    ReDim data(1 To rng.Rows.Count)
    
    For i = 1 To rng.Rows.Count
        data(i) = rng(i, 1).Value
    Next i
    
    colRangeToArray = data
End Function


Public Function interp1DRange(xRange As Range, yRange As Range, xiRange As Range, extrapolate As Boolean) As Variant
    ' Convert input ranges to 1D VB arrays.
    Dim x() As Variant
    Dim y() As Variant
    Dim xi() As Variant
    If xRange.Rows.Count = 1 Then
        x = rowRangeToArray(xRange)
    Else
        x = colRangeToArray(xRange)
    End If
    If yRange.Rows.Count = 1 Then
        y = rowRangeToArray(yRange)
    Else
        y = colRangeToArray(yRange)
    End If
    If xiRange.Rows.Count = 1 Then
        xi = rowRangeToArray(xiRange)
    Else
        xi = colRangeToArray(xiRange)
    End If
    
    ' Call interp1D function and return result with same orientation as inputs.
    Dim result As Variant
    result = interp1D(x, y, xi, extrapolate)
    
    ' Transpose if inputs were columns.
    If xRange.Columns.Count = 1 Then
        result = Application.Transpose(result)
    End If
    
    interp1DRange = result  
End Function            
                    
                

Second Method

Note that only the interp1D private function definition is provided. All other definitions remain unchanged.

                        
Private Function interp1D(ByVal x As Variant, ByVal y As Variant, ByVal xi As Variant, Optional ByVal extrapolate As Boolean = False) As Variant
    ' Performs 1D linear interpolation, with optional linear extrapolation.
    
    ' Inputs:
    ' x - 1D array of independent variable sample points.
    ' y - 1D array of corresponding values.
    ' xi - 1D array of query points.
    ' extrapolate - Boolean flag for linear extrapolation.
    
    ' Output:
    ' A 1D array of interpolated/extrapolated values, with the same dimensions as xi.
    
    Dim n As Long, ni As Long
    Dim yi() As Variant
    
    ' Verify that x and y have equal number of elements.
    If UBound(x) <> UBound(y) Then
        interp1D = CVErr(xlErrValue)
        Exit Function
    End If
    
    ' Get max dims.
    n = UBound(x)
    ni = UBound(xi)
    
    ' Initialise output array.
    ReDim yi(1 To ni)
    
    ' Loop over query points and interpolate/extrapolate.
    ' In both cases we take the given segment of x and y, work out the equation of the
    ' line that would pass through (x0, y0) and (x1, y1), then evaluate at the target
    ' point.
    For i = 1 To ni
        If xi(i) < x(1) Then
            If extrapolate Then                
                dy = y(2) - y(1)
                dx = x(2) - x(1)
                m = dy / dx
                b = y(1) - m * x(1)
                yi(i) = m * xi(i) + b
            Else
                yi(i) = CVErr(xlErrNA)
            End If
        ElseIf xi(i) >= x(1) And xi(i) <= x(n) Then
            ' Interpolate.
            For j = 1 To n - 1
                If xi(i) >= x(j) And xi(i) <= x(j + 1) Then
                    dy = y(j + 1) - y(j)
                    dx = x(j + 1) - x(j)
                    m = dy / dx
                    b = y(j) - m * x(j)
                    yi(i) = m * xi(i) + b
                    Exit For
                End If
            Next j 
        Else
            If extrapolate Then   
                dy = y(n) - y(n - 1)
                dx = x(n) - x(n - 1)
                m = dy / dx
                b = y(n) - m * x(n)
                yi(i) = m * xi(i) + b
            Else
                yi(i) = CVErr(xlErrNA)
            End If
        End If
    Next i
    
    interp1D = yi
End Function              
                        
                    
Top