Catastrophic Error message

I cannot be much (and by much, I mean any) help, but I have a similar problem (misery loves company, right?). Mine is simpler, so maybe with fewer variables in the equation, someone can solve both of our problems. Please help!

I am using Excel 2003 SP3 on Windows XP Pro SP3. We have a shared file that we have added two user-defined functions to (functions below). When we open this off the network, sometimes we will get the catastrophic failure error message, sometimes not. To "fix", we set macro security to medium, open the file with macros disabled, unshare, save, reshare, save and then reopen with macros enabled. This works for most users (those with my configuration) for a while. We have one guy who has Excel 2003 SP2 on Windows 2000 (not sure what SP at the moment) who whenever he opens the file he ALWAYS gets the catastrophic failure error message. Is he hurting the rest of us? Is there something wrong with the code below?

One last note. When the workbook is shared, it takes about 12 seconds to open (it is calculating, presumably). When it is not shared, it takes about 2 seconds. This is regardless of whether it is physically located on our network server or on my local pc.

Any help is greatly appreciated.

Code (note, both functions are nearly identical to each other; just reference a different column in one part):

Function Select_A_Row_P(Returner As Integer)
Application.Volatile
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim a As Integer
Dim b As Integer
Dim arrRows() As Integer
Dim arrDate() As Date
Dim arrOutput() As Integer

ReDim arrRows(0)
ReDim arrDate(0)
ReDim arrOutput(0)

x = 3
Do While Sheets("Sales -Agreement Quotes").Range("I" & x).Value <> ""
If Sheets("Sales -Agreement Quotes").Range("F" & x).Value = "Pending-Purch" Then
ReDim Preserve arrRows(UBound(arrRows) + 1)
ReDim Preserve arrDate(UBound(arrDate) + 1)
arrRows(UBound(arrRows)) = x
arrDate(UBound(arrDate)) = Sheets("Sales -Agreement Quotes").Range("C" & x).Value
End If
x = x + 1
Loop

a = UBound(arrDate)
x = 1
b = 1
z = 1
Do While x < a + 1
strTest = arrDate(x)
If strTest <> 0 Then
For Each dteDate In arrDate
If dteDate <> 0 Then
If dteDate < strTest Then
strTest = dteDate
End If
End If
Next dteDate

y = 0
Do While y < a + 1
If strTest = arrDate Then
ReDim Preserve arrOutput(b)
arrOutput(b) = arrRows
arrDate = 0
b = b + 1
y = y + a + 1
End If
y = y + 1
Loop
If arrDate(x) = 0 Then x = x + 1
Else
x = x + 1
End If
Loop

Select_A_Row_P = arrOutput(Returner)
End Function
Function Select_A_Row_S(Returner As Integer)
Application.Volatile
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim a As Integer
Dim b As Integer
Dim arrRows() As Integer
Dim arrDate() As Date
Dim arrOutput() As Integer

ReDim arrRows(0)
ReDim arrDate(0)
ReDim arrOutput(0)

x = 3
Do While Sheets("Sales -Agreement Quotes").Range("I" & x).Value <> ""
If Sheets("Sales -Agreement Quotes").Range("F" & x).Value = "Pending-Sales" Then
ReDim Preserve arrRows(UBound(arrRows) + 1)
ReDim Preserve arrDate(UBound(arrDate) + 1)
arrRows(UBound(arrRows)) = x
arrDate(UBound(arrDate)) = Sheets("Sales -Agreement Quotes").Range("C" & x).Value
End If
x = x + 1
Loop

a = UBound(arrDate)
x = 1
b = 1
z = 1
Do While x < a + 1
strTest = arrDate(x)
If strTest <> 0 Then
For Each dteDate In arrDate
If dteDate <> 0 Then
If dteDate < strTest Then
strTest = dteDate
End If
End If
Next dteDate

y = 0
Do While y < a + 1
If strTest = arrDate Then
ReDim Preserve arrOutput(b)
arrOutput(b) = arrRows
arrDate = 0
b = b + 1
y = y + a + 1
End If
y = y + 1
Loop
If arrDate(x) = 0 Then x = x + 1
Else
x = x + 1
End If
Loop

Select_A_Row_S = arrOutput(Returner)
End Function