Error after running code

[Shellgrip]

I'm being plagued by the dreaded 'MS Excel for Windows has encountered a problem...'. It occurs every single time I attempt to close the file but ONLY after I've run the code contained within a userform. If the code isn't run, the file closes happily without errors, if it's run (regardless of the options chosen) the error occurs.

It's only recently started so I'm thinking it's some part of code that has been recently written but what, I'm clueless. The code opens (and closes) another book and I'm wondering if this external event is causing the problem.

Can anyone give any pointers to what may be causing this error? Code below - I've included everything as I haven't a clue which bit might be the problem. The purpose is to take data from a number of sheets on another workbook, sorting them by date and sheets selected. The data on the remote book isn't terribly consistent so there's a bit of fudging to catch odd formats and dates in varying locations. I've edited some of the code for security but nothing that affects functionality.



Dim BkSchedule, BkLisa As Workbook
Dim BkLisaSheet, BkLisaDate As Worksheet
Public FromDate, ToDate As Date
Dim LabSheet As String
Dim ClearRange As Range

Private Sub cmdLookUp_Click()
Application.DisplayAlerts = False 'Prevents warning deleting copied worksheet
Set ClearRange = Worksheets("Results").Range("A1:M500") 'Clears previous results
ClearSheet ClearRange
Set ClearRange = Worksheets("byDate").Range("A1:M500")
ClearSheet ClearRange
L = 3 'Starting line for writing results
Set BkLisa = Workbooks(1)
FromDate = txtFromDate
ToDate = txtToDate
Workbooks.Open "s:\2005 Schedule.xls" 'Make sure this file is HERE
Set BkSchedule = Workbooks(2)
BkLisa.Activate
Set BkLisaSheet = BkLisa.Worksheets("Results")
Set BkLisaDate = BkLisa.Worksheets("byDate")
If chkOne Then CountItems L, "Choice 1", 5 'Checks for checked Labels
If chkTwo Then CountItems L, "Choice 2", 5
If chkThree Then CountItems L, "Choice 3", 5
If chkFour Then CountItems L, "Choice 4", 5
If chkFive Then CountItems L, "Choice 5", 5
If chkSix Then CountItems L, "Choice 6", 6
If chkSeven Then CountItems L, "Choice 7", 5
BkSchedule.Close
WritebyDate 'Routine for writing out date order schedule
BkLisaSheet.Columns("T:T").Delete 'Delete the date reference columns used for sort
BkLisaDate.Columns("T:T").Delete
BkLisaDate.Activate
BkLisaDate.Cells(1, 2).Activate
frmLookUp.Hide
Application.DisplayAlerts = True
End Sub

Private Sub CountItems(L, LabSheet, DateCol) ' L is L, Labsheet the sheet and Datecol the date col
With BkLisaSheet 'Apply formatting to sheet heading and label headings
.Cells(L, 1).Value = LabSheet
.Cells(1, 1).Value = "Schedule by Label"
.Cells(1, 1).Font.Bold = True
.Cells(L, 1).Font.Bold = True
.Cells(1, 1).Font.Size = 14
.Cells(L, 1).Font.Size = 13
End With
LL = L 'LL is flag variable for detecting hits on a sheet
L = L + 1 'L Counter (writing row on Results sheet)
For J = 1 To 500 'J Counter (reading row on schedule workbook)
K = 1 'K Counter (reading column on schedule workbook)
If BkSchedule.Worksheets(LabSheet).Cells(J, 2) <> 0 Then
RelDate = BkSchedule.Worksheets(LabSheet).Cells(J, DateCol)
DateTest = ((FromDate < RelDate) And (RelDate < ToDate)) Or (Not IsDate(RelDate)) 'Boolean result from date test
If DateTest Then
Do While K < 20
BkLisaSheet.Cells(L, K) = BkSchedule.Worksheets(LabSheet).Cells(J, K)
BkLisaSheet.Cells(L, K).Interior.ColorIndex = BkSchedule.Worksheets(LabSheet).Cells(J, K).Interior.ColorIndex
BkLisaSheet.Cells(L, 20) = BkSchedule.Worksheets(LabSheet).Cells(J, DateCol)
K = K + 1
Loop
'Following lines check for 'weird' date formats (e.g. 2005, October)
JulDate = (34000 < BkLisaSheet.Cells(L, DateCol)) And (BkLisaSheet.Cells(L, DateCol) < 40000)
If JulDate Then BkLisaSheet.Cells(L, DateCol).NumberFormat = "d-mmm-yy"
BkLisaSheet.Cells(L, DateCol - 1).NumberFormat = "0"
L = L + 1
End If
End If
Next J
If LL = L - 1 Then ' Reset heading (and formatting) if no hits for that sheet
With BkLisaSheet.Cells(LL, 1)
.Value = ""
.Font.Bold = False
.Font.Size = 10
End With
L = L - 1
End If
End Sub

Private Sub WritebyDate()
J = 3 'Start row for reading results
D = 1 'Writing row on date sheet
Do While J < 100
If BkLisaSheet.Cells(J, 2) = "" Then J = J + 1
For K = 1 To 20
With BkLisaDate.Cells(D, K)
.Value = BkLisaSheet.Cells(J, K)
.NumberFormat = BkLisaSheet.Cells(J, K).NumberFormat
.Interior.ColorIndex = BkLisaSheet.Cells(J, K).Interior.ColorIndex
End With
Next K
J = J + 1
D = D + 1
Loop
BkLisaDate.Copy After:=Sheets(3)
Set ClearRange = Worksheets("byDate").Range("A1:M500")
ClearSheet ClearRange
J = 1 'Counter
D = 1 'Row for deletion
W = 3 'Row to write
With BkLisaDate.Cells(1, 1)
.Value = "Schedule by Date"
.Font.Bold = True
.Font.Size = "14"
End With
Do While BkLisa.Sheets(4).Cells(J, 1) <> "" 'Sort results
FirstDate = BkLisa.Sheets(4).Cells(1, 20)
Do While BkLisa.Sheets(4).Cells(J, 1) <> ""
If BkLisa.Sheets(4).Cells(J, 20) <= FirstDate Then
FirstDate = BkLisa.Sheets(4).Cells(J, 20)
D = J
End If
J = J + 1
Loop
For K = 1 To 19
BkLisaDate.Cells(W, K) = BkLisa.Sheets(4).Cells(D, K)
BkLisaDate.Cells(W, K).Interior.ColorIndex = BkLisa.Sheets(4).Cells(D, K).Interior.ColorIndex
BkLisaDate.Cells(W, K).NumberFormat = BkLisa.Sheets(4).Cells(D, K).NumberFormat
Next K
BkLisa.Sheets(4).Rows(D).Delete
J = 1
W = W + 1
Loop
BkLisa.Sheets(4).Delete
End Sub

Private Sub ClearSheet(ClearRange) 'Routine for wiping sheets clean
With ClearRange
.Value = ""
.NumberFormat = "General"
.Font.Size = "10"
.Font.Bold = False
.Interior.ColorIndex = xlColorIndexNone
End With
End Sub

[Killian]

Hi there,

I believe your problem is on the second to last line of the click event:


frmLookUp.Hide

It's fine to Hide a form if you plan to use it again since it remains in memory. And there's your problem... There are a whole stack of variables and object references in memory and when you quit the workbook, Excel doesn't know what to do with them and dies horribly.
You need to use


Unload frmLookUp

which does what it says on the tin, as it were.

[Shellgrip]

Killian, yep, spot on, that's solved it :clap:

What I've actually done is put the Unload in the 'BeforeClose' event of the book since that allows the form to retain settings from previous runs while the book is open. Many thanks for the very quick reply!

Jon