XLOOKUPINTERPOLATE

Returns an interpolated value if an exact match is not found.

Public Function XLOOKUPINTERPOLATE( _ 
         ByVal lookup_value As Double, _ 
         ByVal lookup_array As Range, _ 
         ByVal return_array As Range) _ 
         As Variant 

Dim i As Long 
Dim n As Long 
Dim x1 As Double, x2 As Double 
Dim y1 As Double, y2 As Double 
    
    n = lookup_array.Count 
    
    ' Ensure both ranges are the same size
    If n <> return_array.Count Then 
        XLOOKUPINTERPOLATE = CVErr(xlErrRef) 
        Exit Function 
    End If 
    
    ' Loop through lookup_array to find position
    For i = 1 To n 
        If lookup_value = lookup_array.Cells(i).Value Then 
            ' Exact match
            XLOOKUPINTERPOLATE = return_array.Cells(i).Value 
            Exit Function 
        End If 
        
        If lookup_value < lookup_array.Cells(i).Value Then 
            ' Interpolate between i-1 and i
            If i = 1 Then 
                ' Below range ? return first value
                XLOOKUPINTERPOLATE = return_array.Cells(1).Value 
                Exit Function 
            End If 
            
            x1 = lookup_array.Cells(i - 1).Value 
            x2 = lookup_array.Cells(i).Value 
            y1 = return_array.Cells(i - 1).Value 
            y2 = return_array.Cells(i).Value 
            
            ' Linear interpolation
            XLOOKUPINTERPOLATE = y1 + (lookup_value - x1) * (y2 - y1) / (x2 - x1) 
            Exit Function 
        End If 
    Next i 
    
    ' Above the highest value ? return last
    XLOOKUPINTERPOLATE = return_array.Cells(n).Value 
End Function