VBA Express : Excel - UDF to interpolate and extrapolate from values in lookup tables

Excel

UDF to interpolate and extrapolate from values in lookup tables

Ease of Use

Easy

Version tested with

97, 2K, 2003

Submitted by:

dcardno

Description:

Function will search for a value in a lookup range (ie, "known X Values"), and return a corresponding Y value. If the supplied "X" does not match a value in the "known X" values, it will interpolate to get an estimated Y value. Optionally, the function will extrapolate for X values outside the range of known Xs

Discussion:

Sometimes we need to interpolate results for a variable between known values - for example, if 10 boxes of oranges weigh 20 pounds, and 20 boxes weigh 35 pounds we need to be able to estimate the weight of 15 boxes (trick question; I have assumed some dunnage, so while the relationship may be linear, the line does not go through the origin). The question is even more difficult if we know that 5 boxes weigh 15 pounds, and 30 boxes weigh 46 pounds, and we need an estimate of the weight for various numbers of boxes from 5 to 30. The function is also useful if the relationship includes a step function, so long as you can provide known Xs very close to the step boundary. This function will accept an input value (the new "X" value for which we want to estimate a new "Y" value), two cell ranges coresponding to the known "X" and "Y" values, and an optional parameter to control how it responds to X values larger or smaller than the known values of X provided. The X and Y ranges can be either rows or columns, and do not need to be continguous. Worksheet formulas can be used for the same result, but it requires a couple of INDEX and MATCH functions, and it is easy to create errors using them.

Code:

instructions for use

			Function Interpolate(X As Single, XRange As Range, YRange As Range, Optional InterpType As Integer = 0) 
     
     ' Function returns interpolated value of "Y" for supplied X, based on supplied ranges of known
     ' X and Y values.  Optional "InterpType argument controls how function responds to X arguments
     ' outside the known X values:
     '   If InterpType is:
     '   = 0: returns an error (default)
     '   = 1: extrapolates based on last two X-Y pairs (either two highest or two lowest)
     '   = 2: extrapolates based on first and last X-Y pair (full range of supplied values)
     '   = 3: extrapolates based on first or last X-Y pair and the origin (0-0)
     '    Other values return an error
     
     ' Function is based on the "InterpolateVLOOKUP" UDF developed by Myrna Larson, and published in the
     ' Excel Expert's E-Letter, which can be found at: http://www.j-walk.com/ss/excel/eee/eee002.txt
     
    Dim blErr      As Boolean 
    Dim iBase      As Integer 
    Dim iComp      As Integer 
    Dim i          As Integer 
    Dim dX0        As Double 
    Dim dX1        As Double 
    Dim dY0        As Double 
    Dim dY1        As Double 
    Dim Temp       As Variant 
     
    On Error Resume Next 
     
     ' ensure that XRange is sorted ascending so match function result is reliable
    For i = 1 To XRange.Count - 1 
        If XRange(i + 1) < XRange(i) Then blErr = True 
    Next 
     
    Temp = WorksheetFunction.Match(X, XRange, 1) 
    If IsError(Temp) Then 
        Interpolate = CVErr(Temp) 
    Else 
        iBase = CInt(Temp) 
        Select Case iBase 
        Case 0 
             'match function did not find a match - X =< min(XRange)
            Select Case InterpType 
            Case 0 
                If X = XRange(1) Then 'X is not less than min(XRange) it is equal
                    iBase = 1 
                Else 'X IS < lowest value in range - represents error
                    blErr = True 
                End If 
            Case 1 
                iBase = 1 
                iComp = 2 
            Case 2 
                iBase = 1 
                iComp = XRange.Count 
            Case 3 
                iBase = 1 
                iComp = 0 
            Case Else 
                blErr = True 
            End Select 
        Case XRange.Count 
             'match returns last value in XRange, so X is >= max(XRange)
            Select Case InterpType 
            Case 0 
                If X <> XRange(XRange.Count) Then 'X IS > highest value in range - represents an error
                    blErr = True 
                End If 
            Case 1 
                iComp = iBase - 1 
            Case 2 
                iComp = 1 
            Case 3 
                iComp = 0 
            Case Else 
                blErr = True 
            End Select 
        Case Else 
             'match returned position of value next larger than X, within XRange
            iComp = iBase + 1 
        End Select 
        dX0 = XRange(iBase) 
        dY0 = YRange(iBase) 
        If X = dX0 Then 
            Interpolate = dY0 
        Else 
            dX1 = XRange(iComp) 
            dY1 = YRange(iComp) 
        End If 
        If blErr = True Then 
            Err.Raise Number:=11 
            Interpolate = CVErr(Err) 
             'return "div0" error, to ensure that error propagates through s/sheet calculations
        Else 
            Interpolate = (X - dX0) / (dX1 - dX0) * (dY1 - dY0) + dY0 
        End If 
    End If 
     
End Function

How to use:

Insert the code in a module in the spreadsheet where the function is needed. I would not recommend putting it in personal.xls, since then it will not be available to other users of the spreadsheet.
In the spreadsheet, insert the formula: =interpolate(X,[XRangeReference],[YRangeReference],<param>), where X is the value you wish to evaluate, [XRangeReference] is the range of known X values (these values must be in ascending order), [YRangeReference] is the range of known Y values coresponding to the known X values, and <param> is an optional value indicating how to treat X values that are larger or smaller than the values in [XRangeReference].
If <param> = 0 or is omitted, such an X value will return an error; if <param> = 1 the function will extrapolate based on the two largest or two smallest data-pairs (depending on whether X is larger or smaller than the range of supplied X values); if <param> = 2 it will extrapolate based on the largest and smallest data pairs; if <param> = 3 it will extrapolate based on the origin (0,0) and the nearest (largest or smallest) data pair.
Be cautious about extrapolating - the default is to return an error because in many cases extrapolations are unreliable. The function allows extrapolation to cover instances where the user may need to evaluate X values just slightly out of the range of known values.
If a user has to deal with large gaps in their data, they should investigate more advanced curve-fitting options in Excel, or otherwise ensure the reliability of their calculations
The attached file includes example of how the different <param> settings affect the results. Note that [XRange] and [YRange] do not have to be adjacent to one another and can be either in rows or columns or even mixed - one as a row, one as a column, (although I can't think of a time that would be useful). The two reference ranges will read from left to right, and top to bottom.

Test the code:

Refer to the 'How to use:' section or the attached file.

Sample File:

Interpolate.zip 12.94KB

Approved by mdmackillop

This entry has been viewed 233 times.