Hi,
I have been developing a "Lessons Learned" database to record incidents, accidents, and near misses in a program I am working with. Data entry is performed via a form I have created. It has, over time, become more complex as I try to meet requests for more functionality. I suspect I've tried to cram way too much into this form. And now, I am experiencing an issue I think may be related to memory. I hoping for some advice to help me perhaps eliminate whatever may be causing the issue. The issue doesn't occur when I enter one or two records, then close the form. But when I enter three or more records, it crashes. So here are some of the details, and thanks in advance for any help!
Screen shots of the error msg, debugger, and form:
error msg 1.png
error msg.png
form.png
VBA Code:
Private Sub UserForm_Initialize()
'Safety Record form
Dim Cloc As Range
Dim CCat As Range
Dim CPhase As Range
Dim CSubC As Range
Dim dte As Date
Dim ws As Worksheet
Set ws = Worksheets("Lookups")
For Each Cloc In ws.Range("Site_Name")
With Me.Site
.AddItem Cloc.Value
End With
Next Cloc
For Each CPhase In ws.Range("Phase")
With Me.cboPhase
.AddItem CPhase.Value
End With
Next CPhase
For Each CCat In ws.Range("safety")
With Me.cbo_cat
.AddItem CCat.Value
End With
Next CCat
For Each CSubC In ws.Range("subcatS")
With Me.cbo_subcatS
.AddItem CSubC.Value
End With
Next CSubC
End Sub
Private Sub cmdAdd_Click()
Dim lrow As Long
Dim ws As Worksheet
Set ws = Worksheets("Master")
'find first empty row in database
lrow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a date
If Trim(Me.txtDate.Value) = "" Then
Me.txtDate.SetFocus
MsgBox "Please enter date"
Exit Sub
End If
'check for a site
If Trim(Me.Site.Value) = "" Then
MsgBox "Please selecta a site"
Exit Sub
End If
'check for Reporting Contractor
If Trim(Me.txtReptC.Value) = "" Then
MsgBox "Please provide Reporting Contractor"
Exit Sub
End If
'Copy the data to the database
ws.Cells(lrow, 1).Value = Me.txtDate.Value
ws.Cells(lrow, 2).Value = Me.Site.Value
ws.Cells(lrow, 3).Value = Me.txtReptC.Value
ws.Cells(lrow, 4).Value = Me.TxtSubC.Value
ws.Cells(lrow, 5).Value = Me.cboPhase.Value
ws.Cells(lrow, 6).Value = Me.cbo_cat.Value
ws.Cells(lrow, 7).Value = Me.but_OSHA.Value
ws.Cells(lrow, 8).Value = Me.But_FirstAid.Value
ws.Cells(lrow, 9).Value = Me.But_Lost.Value
ws.Cells(lrow, 10).Value = Me.txt_daysLost
ws.Cells(lrow, 11).Value = Me.But_Restricted.Value
ws.Cells(lrow, 12).Value = Me.Txt_Restrict.Value
ws.Cells(lrow, 13).Value = Me.But_Utility.Value
ws.Cells(lrow, 14).Value = Me.But_PropDam.Value
ws.Cells(lrow, 15).Value = Me.Txt_value.Value
ws.Cells(lrow, 16).Value = Me.txt_Describe.Value
ws.Cells(lrow, 17).Value = Me.Txt_Lesson.Value
ws.Cells(lrow, 18).Value = Me.cbo_subcatS.Value
ws.Cells(lrow, 19).Value = Application.UserName
ws.Cells(lrow, 20).Value = Now
ws.Cells(lrow, 20).NumberFormat = "mm/dd/yyyy hh:mm:ss"
'clear the data
Me.txtDate.Value = ""
Me.Site.Value = ""
Me.txtReptC.Value = ""
Me.TxtSubC.Value = ""
Me.cboPhase.Value = ""
Me.cbo_cat.Value = ""
Me.cbo_subcatS.Value = ""
Me.but_OSHA.Value = ""
Me.But_FirstAid.Value = ""
Me.But_Lost.Value = ""
Me.txt_daysLost.Value = ""
Me.But_Restricted.Value = ""
Me.Txt_Restrict.Value = ""
Me.But_Utility.Value = ""
Me.But_PropDam.Value = ""
Me.Txt_value = ""
Me.txt_Describe.Value = ""
Me.Txt_Lesson.Value = ""
Me.txtDate.SetFocus
End Sub
Private Sub ListRecord_Click()
'dim the variables
Dim i As Integer
'find the selected item
i = Me.ListRecord.ListIndex
Me.ListRecord.Selected(i) = True
'add the values to the text boxes
Me.txtDate.Value = Me.ListRecord.Column(0, i)
Me.Site.Value = Me.ListRecord.Column(1, i)
Me.txtReptC.Value = Me.ListRecord.Column(2, i)
Me.TxtSubC.Value = Me.ListRecord.Column(3, i)
Me.cboPhase.Value = Me.ListRecord.Column(4, i)
Me.cbo_cat.Value = Me.ListRecord.Column(5, i)
Me.cbo_subcatS.Value = Me.ListRecord.Column(6, i)
Me.but_OSHA.Value = Me.ListRecord.Column(7, i)
Me.But_FirstAid.Value = Me.ListRecord.Column(8, i)
Me.But_Lost.Value = Me.ListRecord.Column(9, i)
Me.txt_daysLost.Value = Me.ListRecord.Column(10, i)
Me.But_Restricted.Value = Me.ListRecord.Column(11, i)
Me.Txt_Restrict.Value = Me.ListRecord.Column(12, i)
Me.But_Utility.Value = Me.ListRecord.Column(13, i)
Me.But_PropDam.Value = "Me.ListRecord.Column(14, i )"
Me.Txt_value = Me.ListRecord.Column(15, i)
Me.txt_Describe.Value = Me.ListRecord.Column(16, i)
Me.Txt_Lesson.Value = Me.ListRecord.Column(17, i)
'format date as a date
End Sub
Private Sub PrevRec_Click()
'scroll back through previous records
Dim i As Integer
'select item message
If Me.ListRecord.Value = "" Then
MsgBox "Please select an item in the list above by clicking on it"
Exit Sub
End If
'find record
i = Me.ListRecord.ListIndex
Me.ListRecord.Selected(i) = True
If i = 0 Then Exit Sub
'populate form with data from prev record
Me.txtDate.Value = Me.ListRecord.Column(0, i)
Me.Site.Value = Me.ListRecord.Column(1, i)
Me.txtReptC.Value = Me.ListRecord.Column(2, i)
Me.TxtSubC.Value = Me.ListRecord.Column(3, i)
Me.cboPhase.Value = Me.ListRecord.Column(4, i)
Me.cbo_cat.Value = Me.ListRecord.Column(5, i)
Me.cbo_subcatS.Value = Me.ListRecord.Column(6, i)
Me.but_OSHA.Value = Me.ListRecord.Column(7, i)
Me.But_FirstAid.Value = Me.ListRecord.Column(8, i)
Me.But_Lost.Value = Me.ListRecord.Column(9, i)
Me.txt_daysLost.Value = Me.ListRecord.Column(10, i)
Me.But_Restricted.Value = Me.ListRecord.Column(11, i)
Me.Txt_Restrict.Value = Me.ListRecord.Column(12, i)
Me.But_Utility.Value = Me.ListRecord.Column(13, i)
Me.But_PropDam.Value = "Me.ListRecord.Column(14, i )"
Me.Txt_value = Me.ListRecord.Column(15, i)
Me.txt_Describe.Value = Me.ListRecord.Column(16, i)
Me.Txt_Lesson.Value = Me.ListRecord.Column(17, i)
'select the new row
Me.ListRecord.Selected(i) = True
End Sub
Private Sub NextRec_Click()
'select item message
If Me.ListRecord.Value = "" Then
MsgBox "Please select an item in the list above by clicking on it"
Exit Sub
End If
'find record
i = Me.ListRecord.ListIndex
Me.ListRecord.Selected(i) = True
If i = 0 Then Exit Sub
'populate form with data from prev record
Me.txtDate.Value = Me.ListRecord.Column(0, i + 1)
Me.Site.Value = Me.ListRecord.Column(1, i + 1)
Me.txtReptC.Value = Me.ListRecord.Column(2, i + 1)
Me.TxtSubC.Value = Me.ListRecord.Column(3, i + 1)
Me.cboPhase.Value = Me.ListRecord.Column(4, i + 1)
Me.cbo_cat.Value = Me.ListRecord.Column(5, i + 1)
Me.cbo_subcatS.Value = Me.ListRecord.Column(6, i + 1)
Me.but_OSHA.Value = Me.ListRecord.Column(7, i + 1)
Me.But_FirstAid.Value = Me.ListRecord.Column(8, i + 1)
Me.But_Lost.Value = Me.ListRecord.Column(9, i + 1)
Me.txt_daysLost.Value = Me.ListRecord.Column(10, i + 1)
Me.But_Restricted.Value = Me.ListRecord.Column(11, i + 1)
Me.Txt_Restrict.Value = Me.ListRecord.Column(12, i + 1)
Me.But_Utility.Value = Me.ListRecord.Column(13, i + 1)
Me.But_PropDam.Value = "Me.ListRecord.Column(14, i + 1)"
Me.Txt_value = Me.ListRecord.Column(15, i + 1)
Me.txt_Describe.Value = Me.ListRecord.Column(16, i + 1)
Me.Txt_Lesson.Value = Me.ListRecord.Column(17, i + 1)
'select the new row
Me.ListRecord.Selected(i + 1) = True
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Bookmarks