Excel Linear Interpolation VBA - vba

Question

this function interpolates/extrapolates a table of known x,y
For example,
x y
1 10
2 15
3 20
Linterp(A1:B3, -1) = 0
However, this code can only do two adjacent arrays.
I would like to modify this code so that I can
select two separate arrays, for example N106:N109,P106:P109.
How can I make this adjustment in this code?
Function Linterp(r As Range, x As Double) As Double
' linear interpolator / extrapolator
' R is a two-column range containing known x, known y
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
'If x = 1.5 Then Stop
nR = r.Rows.Count
If nR < 2 Then Exit Function
If x < r(1, 1) Then ' x < xmin, extrapolate
l1 = 1: l2 = 2: GoTo Interp
ElseIf x > r(nR, 1) Then ' x > xmax, extrapolate
l1 = nR - 1: l2 = nR: GoTo Interp
Else
' a binary search would be better here
For lR = 1 To nR
If r(lR, 1) = x Then ' x is exact from table
Linterp = r(lR, 2)
Exit Function
ElseIf r(lR, 1) > x Then ' x is between tabulated values, interpolate
l1 = lR: l2 = lR - 1: GoTo Interp
End If
Next
End If
Interp:
Linterp = r(l1, 2) _
+ (r(l2, 2) - r(l1, 2)) _
* (x - r(l1, 1)) _
/ (r(l2, 1) - r(l1, 1))
End Function

Answer 1

one very simple way is having the function accepting two ranges in input, one for X values (say rX) and one for Y ones (say rY), and then changing every occurrence of r(foo,1) to rX(foo) and r(foo,2) to rY(foo)
like follows
Option Explicit
Function Linterp2(rX As Range, rY As Range, x As Double) As Double
' linear interpolator / extrapolator
' R is a two-column range containing known x, known y
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
'If x = 1.5 Then Stop
nR = rX.Rows.Count
If nR < 2 Then Exit Function
If x < rX(1) Then ' x < xmin, extrapolate
l1 = 1: l2 = 2: GoTo Interp
ElseIf x > rX(nR) Then ' x > xmax, extrapolate
l1 = nR - 1: l2 = nR: GoTo Interp
Else
' a binary search would be better here
For lR = 1 To nR
If rX(lR) = x Then ' x is exact from table
Linterp2 = rY(lR)
Exit Function
ElseIf rX(lR) > x Then ' x is between tabulated values, interpolate
l1 = lR: l2 = lR - 1: GoTo Interp
End If
Next
End If
Interp:
Linterp2 = rY(l1) _
+ (rY(l2) - rY(l1)) _
* (x - rX(l1)) _
/ (rX(l2) - rX(l1))
End Function
but you must implement code to check for consistency of the two ranges, like being both of one column each and with the same number of rows

Answer 2

use this function :
Public Function lineare_iterpolation(x As Variant, x1 As Variant, x2 As Variant, y1 As Variant, y2 As Variant) As Variant
If x = x1 Then
lineare_iterpolation = y1
Exit Function
End If
If x = x2 Then
lineare_iterpolation = y2
Exit Function
End If
lineare_iterpolation = y1 + (x - x1) * (y2 - y1) / (x2 - x1)
Exit Function
End Function