Code:
Private Function Interpolate(ByVal dblIndex1 As Double, _ ByVal dblValue1 As Double, ByVal dblIndex2 As Double, _ ByVal dblValue2 As Double, ByVal dblFindIndex As Double, _ Optional boolExtrapolate As Boolean = True) As Double '******************************************************** 'This function will return the linear interpolated value for dblFindIndex ' ' *------------+-----* ' a c b ' 1 3 5 ' 10 x 50 ' ' To find x at c the correct syntax would be: ' x = Interpolate(1,10,5,50,3) ' and the answer would be 30 '******************************************************** ' Passing a value of true for boolExtrapolate will switch on ' extropolation if find index falls outside the bounds of index1 ' and index2. '******************************************************** 'Trap Errors On Error GoTo Interpolate_Error Dim dblUpperLimitIndex As Double Dim dblUpperLimitValue As Double Dim dblLowerLimitIndex As Double Dim dblLowerLimitValue As Double 'Main Function If Not boolExtrapolate Then 'We are not extrapolating so cap the returned values If dblIndex2 > dblIndex1 Then dblLowerLimitIndex = dblIndex1 dblUpperLimitIndex = dblIndex2 dblLowerLimitValue = dblValue1 dblUpperLimitValue = dblValue2 Else dblLowerLimitIndex = dblIndex2 dblUpperLimitIndex = dblIndex1 dblLowerLimitValue = dblValue2 dblUpperLimitValue = dblValue1 End If If dblFindIndex <= dblLowerLimitIndex Then 'If FindIndex is less than or equal to index1, 'return value will allways be Value1 Interpolate = dblLowerLimitValue GoTo Interpolate_Exit ElseIf dblFindIndex >= dblUpperLimitIndex Then 'If FindIndex is greater than or equal to index2, 'return value will allways be Value2 Interpolate = dblUpperLimitValue GoTo Interpolate_Exit End If End If 'Perform the interpolation Interpolate = dblValue1 + (dblValue2 - dblValue1) * _ (dblFindIndex - dblIndex1) / (dblIndex2 - dblIndex1) 'Exit Interpolate_Exit: Exit Function 'Error Handling Interpolate_Error: Dim Error_Location As String Error_Location = "Interpolate" MsgBox Err.Description, vbExclamation, _ Error_Location & ":" & Err.Number Interpolate = 0 GoTo Interpolate_Exit End Function