VBA Function Keeps Crashing Excel

[axattenb]

I have a VBA function in Excel which looks up data from another workbook, which is normally closed. The function is used several times in the master worksheet.

Sometimes, the function works perfectly OK, but Excel frequently crashes and reboots.

I am running Excel 2010 on a Windows 7 machine, but have also tried copying the files to a PC with XP running Excel 2007, and this also crashes. Any ideas what the problem is? The code for the function is copied below.



Function Cost(SheetIn, TableIn, ColID1, ColID2, RowID)

Dim RRow As Integer 'Row containing the Table Name
Dim RowNo As Integer 'Row with the required data
Dim ColNo As Integer 'Column with the required data
Dim StopRow As Integer 'Number of data rows in the table
Dim CostFile As Workbook 'Workbook containing the Cost Functions
Dim HelpText As String 'Formula output in the event of unsuccessful lookup

Set CostFile = GetObject("D:\Work\Technology\Overall Model\Cost Functions.xlsm")

'------------------------------------------------------------------------------------------------------------------------------------------
'Look for the Worksheet, and output the relevant Help Text if the right sheet doesn't exist
'------------------------------------------------------------------------------------------------------------------------------------------
Check = False
For I = 1 To CostFile.Sheets.Count
If CostFile.Sheets(I).Name = SheetIn Then
Check = True
I = CostFile.Sheets.Count
End If
Next I

If Check = False Then
HelpText = "SheetIn should be one of following: "
For I = 1 To CostFile.Sheets.Count
HelpText = HelpText + CostFile.Sheets(I).Name + ", "
Next I
Cost = HelpText
GoTo 100
End If


'------------------------------------------------------------------------------------------------------------------------------------------
'Look for the Data Table, and output the relevant Help Text if the right table doesn't exist
'Count the number of Rows in the Data Table
'------------------------------------------------------------------------------------------------------------------------------------------
Check = False
For I = 1 To 1000
If CostFile.Sheets(CStr(SheetIn)).Cells(I, 1) = TableIn Then
RRow = I
Check = True
I = 1000
End If
Next I

If Check = False Then
HelpText = "TableIn should be one of following: "
For I = 1 To 1000
If CostFile.Sheets(CStr(SheetIn)).Cells(I, 1) <> "" Then
HelpText = HelpText + CostFile.Sheets(CStr(SheetIn)).Cells(I, 1) + ", "
End If
Next I
Cost = HelpText
GoTo 100
End If

For I = 4 To 104
If CostFile.Sheets(CStr(SheetIn)).Cells(RRow + I, 2) = "" Then
StopRow = I
I = 104
End If
Next I

'------------------------------------------------------------------------------------------------------------------------------------------
'Look for the Columm Headings in Data Table, and output the relevant Help Text if the Column Headings doesn't exist
'------------------------------------------------------------------------------------------------------------------------------------------
Check = False
For J = 3 To 50
If CostFile.Sheets(CStr(SheetIn)).Cells(RRow, J) = ColID1 And CostFile.Sheets(CStr(SheetIn)).Cells(RRow + 1, J) = ColID2 Then
ColNo = J
Check = True
J = 50
End If
Next J

If Check = False Then
For J = 3 To 50
If CostFile.Sheets(CStr(SheetIn)).Cells(RRow, J) = ColID1 Then
Check = True
End If
Next J
If Check = False Then
HelpText = "ColID1 should be one of following: "
For J = 3 To 50
If CostFile.Sheets(CStr(SheetIn)).Cells(RRow, J) <> "" Then
HelpText = HelpText + CostFile.Sheets(CStr(SheetIn)).Cells(RRow, J) + ", "
End If
Next J
Cost = HelpText
GoTo 100
Else
HelpText = "ColID2 should be one of following: "
For J = 3 To 50
If CostFile.Sheets(CStr(SheetIn)).Cells(RRow, J) = ColID1 Then
HelpText = HelpText + CostFile.Sheets(CStr(SheetIn)).Cells(RRow + 1, J) + ", "
End If
Next J
Cost = HelpText
GoTo 100
End If
End If


'------------------------------------------------------------------------------------------------------------------------------------------
'Look for the Row Item in Data Table, and output the relevant Help Text if the Row Item doesn't exist
'------------------------------------------------------------------------------------------------------------------------------------------
Check = False
For I = 3 To StopRow - 1
If CostFile.Sheets(CStr(SheetIn)).Cells(RRow + I, 2) = RowID Then
RowNo = I
Check = True
I = StopRow - 1
End If
Next I

If Check = False Then
HelpText = "RowID should be one of following: "
For I = 3 To StopRow - 1
HelpText = HelpText + CStr(CostFile.Sheets(CStr(SheetIn)).Cells(RRow + I, 2)) + ", "
Next I
Cost = HelpText
GoTo 100
End If

'------------------------------------------------------------------------------------------------------------------------------------------
'Output Result
'------------------------------------------------------------------------------------------------------------------------------------------
Cost = CostFile.Sheets(CStr(SheetIn)).Cells(RRow + RowNo, ColNo)

100 End Function

 

[Derek Brown]

Hello and welcome to The Board.
You could try stepping through the code in debug mode to try to find out where it is failing - but you may find that by doing that, it works every time!
If you have not already done so, you could try installing Office 2010 Service Pack 1 (http://support.microsoft.com/kb/2460049).
Also have a look at Harlan Grove's PULL function (may provide an alternative approach) - not quite sure where you can download it (should come up in a Google search) but see also:
http://www.dailydoseofexcel.com/archives/2004/12/01/indirect-and-closed-workbooks/

 

[axattenb]

Thank you for your suggestions. It appears I have one or two issues with my office installation which I need to fully resolve first. I will also have a go with the Pull function - it looks to do exactly what I want.

 

[Derek Brown]

It is not going to be the cause of the problem because you had the same problem on XP/2007 but just be aware that on a Windows 7 64-bit machine, Microsoft recommends installing the 32-bit version of Office:
http://office.microsoft.com/en-us/w...-version-of-microsoft-office-HA010369476.aspx