Catastrophic Error message

[scarpia1]

I have just written a program for someone with about 3,000 lines of VBA and when they try to open it they said this...

"""
All I get are a long neverending series of error popups such as:

"System Error &H8000FFF (-2147418113). Catastrophic failure."

"Out of memory."

Then the project opens up my Microsoft Visual Basic Debugger to Sheet3 with highlighted text

Then the series repeats."""


I wrote the program on excel for mac 2004, i'm wondering if I wrote code that can't compile with .XML? maybe? also I can't understand, Sheet3 has no subs, so why is data populating into an empty sheet and THEN generating a compile issue (which is what it sounds like)? All code is in modules and userforms (there are 6) , even the function macros I have saved in a separate module. Has anyone come across this problem with 2007 being backwards compatible? Maybe it's just a syntax problem? I have some pictures saved into the sheet for tutorial purposes as well. I don't have access to 2007 so I can't begin to figure this out

TIA

 

[JoshO]

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