Search code examples
vbaexcelinterpolationlinear-interpolation

Excel Linear Interpolation VBA


this function interpolates/extrapolates a table of known x,y For example,

x y
1 10
2 15
3 20

Linterp(A1:B3, -1) = 0

However, this code can only do two adjacent arrays. I would like to modify this code so that I can select two separate arrays, for example N106:N109,P106:P109. How can I make this adjustment in this code?

Function Linterp(r As Range, x As Double) As Double
     ' linear interpolator / extrapolator
     ' R is a two-column range containing known x, known y
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long
     'If x = 1.5 Then Stop

    nR = r.Rows.Count
    If nR < 2 Then Exit Function

    If x < r(1, 1) Then ' x < xmin, extrapolate
        l1 = 1: l2 = 2: GoTo Interp

    ElseIf x > r(nR, 1) Then ' x > xmax, extrapolate
        l1 = nR - 1: l2 = nR: GoTo Interp

    Else
         ' a binary search would be better here
        For lR = 1 To nR
            If r(lR, 1) = x Then ' x is exact from table
                Linterp = r(lR, 2)
                Exit Function

            ElseIf r(lR, 1) > x Then ' x is between tabulated values, interpolate
                l1 = lR: l2 = lR - 1: GoTo Interp

            End If
        Next
    End If

Interp:
    Linterp = r(l1, 2) _
    + (r(l2, 2) - r(l1, 2)) _
    * (x - r(l1, 1)) _
    / (r(l2, 1) - r(l1, 1))

End Function

Solution

  • one very simple way is having the function accepting two ranges in input, one for X values (say rX) and one for Y ones (say rY), and then changing every occurrence of r(foo,1) to rX(foo) and r(foo,2) to rY(foo)

    like follows

    Option Explicit
    
    Function Linterp2(rX As Range, rY As Range, x As Double) As Double
         ' linear interpolator / extrapolator
         ' R is a two-column range containing known x, known y
        Dim lR As Long, l1 As Long, l2 As Long
        Dim nR As Long
         'If x = 1.5 Then Stop
    
        nR = rX.Rows.Count
        If nR < 2 Then Exit Function
    
        If x < rX(1) Then ' x < xmin, extrapolate
            l1 = 1: l2 = 2: GoTo Interp
    
        ElseIf x > rX(nR) Then ' x > xmax, extrapolate
            l1 = nR - 1: l2 = nR: GoTo Interp
    
        Else
             ' a binary search would be better here
            For lR = 1 To nR
                If rX(lR) = x Then ' x is exact from table
                    Linterp2 = rY(lR)
                    Exit Function
    
                ElseIf rX(lR) > x Then ' x is between tabulated values, interpolate
                    l1 = lR: l2 = lR - 1: GoTo Interp
    
                End If
            Next
        End If
    
    Interp:
        Linterp2 = rY(l1) _
        + (rY(l2) - rY(l1)) _
        * (x - rX(l1)) _
        / (rX(l2) - rX(l1))
    
    End Function
    

    but you must implement code to check for consistency of the two ranges, like being both of one column each and with the same number of rows