PDA

View Full Version : Converting Excel 97/2000 to Excel XP/2003

Spiff
11-19-2007, 06:01 PM
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
11-19-2007, 07:38 PM
4 places --

xData(I) = x_Vector(I, 1).Value

or

xData(I) = x_Vector(I, 1)

Bob Phillips
11-20-2007, 03:33 AM
The correct syntax is to use Cells

xData(I) = x_Vector.Cells(I, 1)

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

Spiff
11-20-2007, 10:50 AM

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

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.