View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
JohnJack JohnJack is offline
external usenet poster
 
Posts: 12
Default subscript out of range - how to determine

Thanks Tom,

That will speed up the functions as well (I've learned a lot today).
The reason why I need these functions is that the company I work for
is now converting a lot of spreadsheets to excel, as quattro can't
handle (they crash a lot) the massive sized ones we require. The
other function we are missing and severely need is a linear
interpolation function (which again I can't find and no one seems to
be able to point me to one).

I have written the following function. It linearly interpolates a
value in the 2nd range (y1), by finding the the position of the two
values in the first range (y0) that surround (above and below) the "x"
value which can be a double. The problem is is that this function
really slows down the spreadsheet (it does work), but I was wonder if
anyone could point out places where I could possibly speed it up.

Function LinTerp(y0 As Range, y1 As Range, x As Double)
'this function will return the linear interpulated value corresponding
to the x value found in the y0 range (y0 range has to be in ascending
order)
'the range y0 has cannot be sinusoidal or parabolic as it will find
the first instance in the range
'that surrounds the value being searched for.

Dim VL As Double
Dim y0Num, y1Num, vlpos As Integer
Dim y0Below, y0Above, y1Below, y1Above, A, B, C As Double

y0Num = Application.Count(y0)
y1Num = Application.Count(y1)

If y0Num < y1Num Then 'if the two ranges are not of the same
length, this function should stop as it will calculate the wrong
number
LinTerp = "Ranges Inconsistant"
Else
VL = Application.VLookup(x, y0, 1, True)

'binary search to find the position of VL (Vlpos) in y0 range
Dim foundFlag As Boolean
Dim first, middle, last As Integer
foundFlag = False

first = 1
last = y0Num

Do While (first <= last) And (Not foundFlag)
vlpos = Int((first + last) / 2)
Select Case y0(vlpos, 1)
Case VL
foundFlag = True
Case Is VL
last = vlpos - 1
Case Is < VL
first = vlpos + 1
End Select
Loop

'end of binary search

y0Below = y0(vlpos, 1)
y0Above = y0(vlpos + 1, 1)
y1Below = y1(vlpos, 1)
y1Above = y1(vlpos + 1, 1)

A = y0Above - y0Below
B = x - y0Below
C = B / A

LinTerp = y1Below + (y1Above - y1Below) * C
End If

End Function