Option Explicit
    
Function sbInterp(vX As Variant, vY As Variant, _
           vT As Variant, _
           Optional ByVal sType As String = "Linear", _
           Optional bExtrapolate As Boolean = True, _
           Optional ByVal sExtraType As String) As Variant
'Interpolates y-values for target values vT with known
'y-values vY and known x-values vX with type sType.
'sType can be:
'Const or C
'Linear or L
'LinearInVariance or LIV
'Extrapolation will be done if bExtrapolate is TRUE.
'Extrapolation type sExtraType defaults to sType if empty.
'Values in vX must be in ascending order. #VALUE! error
'indicates illegal sType, #NUM! error indicates that
'extrapolation has been switched off and #N/A tells you
'that x-values are not given in increasing order, or
'y-value count differs from x-value count.
'Source (EN): https://www.sulprobil.de/sbinterp_en/
'Source (DE): https://www.berndplumhoff.de/sbinterp_de/
'(C) (P) by Bernd Plumhoff 25-Dec-2023 PB V0.7
Dim i As Long, iX As Long, iY As Long, iT As Long, k As Long
Dim vTk, vXi
Dim sT As String 'Type of inter- or extrapolation
Dim sEType As String 'Extrapolation type
With Application
On Error Resume Next
iX = vX.Count
iX = UBound(vX)
iY = vY.Count
iY = UBound(vY)
iT = vT.Count
iT = UBound(vT)
On Error GoTo 0
If iX <> iY Then
    sbInterp = CVErr(xlErrNA)
    Exit Function
End If
k = 0
ReDim vX1(1 To iX) As Variant, vY1(1 To iX) As Variant
For i = 1 To iX
    If vX(i) <> "" And vY(i) <> "" Then
        k = k + 1
        vX1(k) = vX(i)
        vY1(k) = vY(i)
    End If
Next i
iX = k
ReDim Preserve vX1(1 To iX) As Variant
ReDim Preserve vY1(1 To iX) As Variant
If iX < 2 Then
    sType = "Const"
    sExtraType = "Const"
Else
    For k = 2 To iX
        If vX1(k) <= vX1(k - 1) Then
            sbInterp = CVErr(xlErrNA)
            Exit Function
        End If
    Next k
End If
ReDim vR(1 To iT) As Variant
If sExtraType = "" Then
    sEType = sType 'Same as interpolation type
Else
    sEType = sExtraType
End If
For k = 1 To iT
    i = 0
    vTk = 0
    vXi = 0
    On Error Resume Next
    i = .Match(vT(k), vX1, 1)
    vTk = vT(k)
    vXi = vX1(i)
    On Error GoTo 0
    If Not bExtrapolate And _
        (i = 0 Or (i = iX And vTk <> vXi)) Then
        vR(k) = CVErr(xlErrNum)
    Else
        sT = sType 'Set to interpolation type
        If i = 0 Then
            i = 1
            sT = sEType 'Set to extrapolation type
        End If
        If i = iX Then
            i = i - 1
            If vTk <> vXi Then
                sT = sEType 'Set to extrapolation type
            End If
            If sT = "C" Or sT = "Const" Then i = i + 1
        End If
        Select Case sT
        Case "C", "Const"
            vR(k) = .Index(vY1, i)
        Case "L", "Linear"
            vR(k) = .Index(vY1, i) + (vTk - .Index(vX1, i)) _
                * (.Index(vY1, i + 1) - .Index(vY1, i)) _
                / (.Index(vX1, i + 1) - .Index(vX1, i))
        Case "LIV", "LinearInVariance"
            On Error Resume Next
            vR(k) = Sqr(.Index(vY1, i) ^ 2# + (vTk - .Index(vX1, i)) _
                * (.Index(vY1, i + 1) ^ 2# - .Index(vY1, i) ^ 2#) _
                / (.Index(vX1, i + 1) - .Index(vX1, i)))
            On Error GoTo 0
        Case Else
            sbInterp = CVErr(xlErrValue)
            Exit Function
        End Select
    End If
Next k
If TypeName(vT) = "Range" Then
    If vT.Rows.Count > vT.Columns.Count Then
        vR = .Transpose(vR)
    End If
ElseIf TypeName(.Caller) = "Range" Then
    If .Caller.Rows.Count > .Caller.Columns.Count Then
        vR = .Transpose(vR)
    End If
End If
sbInterp = vR
End With
End Function