Interpolasi

'********************************************************
'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.
'********************************************************

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

'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