Converting Excel 97/2000 to Excel XP/2003

[Spiff]

Back in my Office 97/2000 days, I wrote a set of four interpolation routines into an .xla file for use: 1) 1D linear interpolation, 2D linear interpolation, 3) 1D spline interpolation, and 2D spline interpolation. I've periodically tried to use these same interpolation routines in Office XP and Office 2003, but without success, so I know I need to revise the code. Unfortunately, I just never seem to have enough time to figure out what needs to be fixed.

Can someone look at the simplest version...the 1D linear interpolation...and suggest what needs to be fixed? The routine is designed to require input of the x-value to be interpolated, the x-vector containing the column or row of x values, and the y-vector containing the column or row of y values. Given the value x, a linearly interpolated value for y is supposed to result. It worked flawlessly in Excel for the earlier versions.

When I try to compile the code, I get an "Wrong number of arguments or invalid property assignment (Error 450)" at the boldfaced line.

The code is as follows:

Public Function Interpolate_Linear_1D(x As Double, x_Vector As Range, y_Vector As Range) As Variant
    Dim xVertical As Boolean
    Dim yVertical As Boolean
    Dim I As Integer
    Dim J As Integer
    Dim N As Integer
    Dim Nx As Integer
    Dim Ny As Integer
    Dim xData() As Double
    Dim yData() As Double
    ' Test the x_Vector array bounds to determine if array is a column or row selection.
    If LBound(x_Vector.Value, 1) = UBound(x_Vector.Value, 1) Then
      xVertical = False
    Else
      xVertical = True
    End If
    ' Test the y_Vector array bounds to determine if array is a column or row selection.
    If LBound(y_Vector.Value, 1) = UBound(y_Vector.Value, 1) Then
      yVertical = False
    Else
      yVertical = True
    End If
    ' Get the number of x values in x_Vector.
    Nx = x_Vector.Count
    ReDim xData(1 To Nx)
    ' Get the number of y values in y_Vector.
    Ny = y_Vector.Count
    ReDim yData(1 To Ny)
    ' Test if Nx not equal Ny.
    If Nx <> Ny Then
      Interpolate_Linear_1D = "Unequal x/y length..."
      Exit Function
    End If
    ' If x_Vector is vertical then...
    If xVertical = True Then
      ' Put the x_Vector values into the xData array.
      For I = 1 To Nx Step 1
      xData(I) = x_Vector.Value(I, 1)
      Next I
      ' Put the y_Vector values into the yData array.
      For I = 1 To Ny Step 1
        yData(I) = y_Vector.Value(I, 1)
      Next I
    ' If y_Vector is vertical then...
    Else
      ' Put the x_Vector values into the xData array.
      For I = 1 To Nx Step 1
        xData(I) = x_Vector.Value(1, I)
      Next I
      ' Put the y_Vector values into the yData array.
      For I = 1 To Ny Step 1
        yData(I) = y_Vector.Value(1, I)
      Next I
    End If
    ' Test if x equals last value in x_Vector array.
    If x = xData(Nx) Then
      Interpolate_Linear_1D = yData(Ny)
      Exit Function
    End If
    ' Check if data is in ascending or descending order.
    If xData(1) < xData(Nx) Then
      ' Test if x is out of range.
      If x < xData(1) Or x > xData(Nx) Then
        Interpolate_Linear_1D = "Out of range..."
        Exit Function
      End If
    Else
      ' Test if x is out of range.
      If x > xData(1) Or x < xData(Nx) Then
        Interpolate_Linear_1D = "Out of range..."
        Exit Function
      End If
    End If
    ' Find the I and J values
    J = 1
    Do
      ' Check if data is in ascending or descending order.
      If xData(1) < xData(Nx) Then
        If x < xData(J) Then
          I = J - 1
          Exit Do
        End If
      Else
        If x > xData(J) Then
          I = J - 1
          Exit Do
        End If
      End If
      J = J + 1
    Loop While J <= Nx
    ' Perform the linear interpolation.
    Interpolate_Linear_1D = yData(J) - (yData(J) - yData(I)) * ((xData(J) - x) / (xData(J) - xData(I)))
End Function

[Paul_Hossler]

4 places --

[VBA]
xData(I) = x_Vector(I, 1).Value
[/VBA]

or

[VBA]
xData(I) = x_Vector(I, 1)
[/VBA]

[Bob Phillips]

The correct syntax is to use Cells

[vba]

xData(I) = x_Vector.Cells(I, 1)
[/vba]

but how about doing away with the loading loops

[vba]

Dim xData
Dim yData
' Test the x_Vector array bounds to determine if array is a column or row selection.
xVertical = LBound(x_Vector.Value, 1) <> UBound(x_Vector.Value, 1)
' Test the y_Vector array bounds to determine if array is a column or row selection.
yVertical = LBound(y_Vector.Value, 1) <> UBound(y_Vector.Value, 1)
' Get the number of x values in x_Vector.
Nx = x_Vector.Cells.Count
' Get the number of y values in y_Vector.
Ny = y_Vector.Cells.Count
ReDim yData(1 To Ny)
' Test if Nx not equal Ny.
If Nx <> Ny Then
Interpolate_Linear_1D = "Unequal x/y length..."
Exit Function
End If
' If x_Vector is vertical then...
If xVertical Then
' Put the x_Vector values into the xData array.
xData = Application.Transpose(x_Vector)
' Put the y_Vector values into the yData array.
yData = Application.Transpose(y_Vector)
'etc
[/vba]

[Spiff]

but how about doing away with the loading loops

[vba]

Dim xData
Dim yData
' Test the x_Vector array bounds to determine if array is a column or row selection.
xVertical = LBound(x_Vector.Value, 1) <> UBound(x_Vector.Value, 1)
' Test the y_Vector array bounds to determine if array is a column or row selection.
yVertical = LBound(y_Vector.Value, 1) <> UBound(y_Vector.Value, 1)
' Get the number of x values in x_Vector.
Nx = x_Vector.Cells.Count
' Get the number of y values in y_Vector.
Ny = y_Vector.Cells.Count
ReDim yData(1 To Ny)
' Test if Nx not equal Ny.
If Nx <> Ny Then
Interpolate_Linear_1D = "Unequal x/y length..."
Exit Function
End If
' If x_Vector is vertical then...
If xVertical Then
' Put the x_Vector values into the xData array.
xData = Application.Transpose(x_Vector)
' Put the y_Vector values into the yData array.
yData = Application.Transpose(y_Vector)
'etc
[/vba]

Thanks to both of you for the simple fixes, although I'm a bit confused by the above code suggestion. I'll have to scratch my head a bit on its functionality.

Again, thanks. You've saved me a bunch of time and headaches.