Hi,
I've created a userform for data entry from a questionnaire. There is a save button which transfers all the information to the worksheet but this takes over 30 seconds to complete. I've tried to fiddle with suppressing events using EnableEvents but it does't help. I'm not sure what to do so any help would be really appreciated! Bellow is the whole userform code, most of the data transfer comes from checkboxes from 18 questions (I named them CB1E/G/A/P for excellent good average poor etc.)
Public EnableEvents As Boolean
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub ClearButton_Click()
Call UserForm_Initialize
End Sub
Private Sub SaveButton_Click()
Dim emptyRow As Long
'Make Sheet1 active
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
If Not EnableEvents Then Exit Sub
Me.EnableEvents = False
If CB1E.Value = True Then Cells(emptyRow, 1).Value = "4"
If CB1G.Value = True Then Cells(emptyRow, 1).Value = "3"
If CB1A.Value = True Then Cells(emptyRow, 1).Value = "2"
If CB1P.Value = True Then Cells(emptyRow, 1).Value = "1"
If CB2E.Value = True Then Cells(emptyRow, 2).Value = "4"
If CB2G.Value = True Then Cells(emptyRow, 2).Value = "3"
If CB2A.Value = True Then Cells(emptyRow, 2).Value = "2"
If CB2P.Value = True Then Cells(emptyRow, 2).Value = "1"
If CB3E.Value = True Then Cells(emptyRow, 3).Value = "4"
If CB3G.Value = True Then Cells(emptyRow, 3).Value = "3"
If CB3A.Value = True Then Cells(emptyRow, 3).Value = "2"
If CB3P.Value = True Then Cells(emptyRow, 3).Value = "1"
If CB4E.Value = True Then Cells(emptyRow, 4).Value = "4"
If CB4G.Value = True Then Cells(emptyRow, 4).Value = "3"
If CB4A.Value = True Then Cells(emptyRow, 4).Value = "2"
If CB4P.Value = True Then Cells(emptyRow, 4).Value = "1"
If CB5E.Value = True Then Cells(emptyRow, 5).Value = "4"
If CB5G.Value = True Then Cells(emptyRow, 5).Value = "3"
If CB5A.Value = True Then Cells(emptyRow, 5).Value = "2"
If CB5P.Value = True Then Cells(emptyRow, 5).Value = "1"
If CB6E.Value = True Then Cells(emptyRow, 6).Value = "4"
If CB6G.Value = True Then Cells(emptyRow, 6).Value = "3"
If CB6A.Value = True Then Cells(emptyRow, 6).Value = "2"
If CB6P.Value = True Then Cells(emptyRow, 6).Value = "1"
If CB7E.Value = True Then Cells(emptyRow, 7).Value = "4"
If CB7G.Value = True Then Cells(emptyRow, 7).Value = "3"
If CB7A.Value = True Then Cells(emptyRow, 7).Value = "2"
If CB7P.Value = True Then Cells(emptyRow, 7).Value = "1"
If CB8E.Value = True Then Cells(emptyRow, 8).Value = "4"
If CB8G.Value = True Then Cells(emptyRow, 8).Value = "3"
If CB8A.Value = True Then Cells(emptyRow, 8).Value = "2"
If CB8P.Value = True Then Cells(emptyRow, 8).Value = "1"
If CB9E.Value = True Then Cells(emptyRow, 9).Value = "4"
If CB9G.Value = True Then Cells(emptyRow, 9).Value = "3"
If CB9A.Value = True Then Cells(emptyRow, 9).Value = "2"
If CB9P.Value = True Then Cells(emptyRow, 9).Value = "1"
If CB10E.Value = True Then Cells(emptyRow, 10).Value = "4"
If CB10G.Value = True Then Cells(emptyRow, 10).Value = "3"
If CB10A.Value = True Then Cells(emptyRow, 10).Value = "2"
If CB10P.Value = True Then Cells(emptyRow, 10).Value = "1"
If CB11E.Value = True Then Cells(emptyRow, 11).Value = "4"
If CB11G.Value = True Then Cells(emptyRow, 11).Value = "3"
If CB11A.Value = True Then Cells(emptyRow, 11).Value = "2"
If CB11P.Value = True Then Cells(emptyRow, 11).Value = "1"
If CB12E.Value = True Then Cells(emptyRow, 12).Value = "4"
If CB12G.Value = True Then Cells(emptyRow, 12).Value = "3"
If CB12A.Value = True Then Cells(emptyRow, 12).Value = "2"
If CB12P.Value = True Then Cells(emptyRow, 12).Value = "1"
If CB13E.Value = True Then Cells(emptyRow, 13).Value = "4"
If CB13G.Value = True Then Cells(emptyRow, 13).Value = "3"
If CB13A.Value = True Then Cells(emptyRow, 13).Value = "2"
If CB13P.Value = True Then Cells(emptyRow, 13).Value = "1"
If CB14E.Value = True Then Cells(emptyRow, 14).Value = "4"
If CB14G.Value = True Then Cells(emptyRow, 14).Value = "3"
If CB14A.Value = True Then Cells(emptyRow, 14).Value = "2"
If CB14P.Value = True Then Cells(emptyRow, 14).Value = "1"
If CB15E.Value = True Then Cells(emptyRow, 15).Value = "4"
If CB15G.Value = True Then Cells(emptyRow, 15).Value = "3"
If CB15A.Value = True Then Cells(emptyRow, 15).Value = "2"
If CB15P.Value = True Then Cells(emptyRow, 15).Value = "1"
If CB16E.Value = True Then Cells(emptyRow, 16).Value = "4"
If CB16G.Value = True Then Cells(emptyRow, 16).Value = "3"
If CB16A.Value = True Then Cells(emptyRow, 16).Value = "2"
If CB16P.Value = True Then Cells(emptyRow, 16).Value = "1"
If CB17E.Value = True Then Cells(emptyRow, 17).Value = "4"
If CB17G.Value = True Then Cells(emptyRow, 17).Value = "3"
If CB17A.Value = True Then Cells(emptyRow, 17).Value = "2"
If CB17P.Value = True Then Cells(emptyRow, 17).Value = "1"
If CBYES.Value = True Then Cells(emptyRow, 18).Value = "Y"
If CBNO.Value = True Then Cells(emptyRow, 18).Value = "N"
Cells(emptyRow, 19).Value = CBmonth.Value
Cells(emptyRow, 20).Value = TByear.Value
Me.EnableEvents = True
Call UserForm_Initialize
End Sub
Private Sub TByear_Enter()
If Not EnableEvents Then Exit Sub
Me.EnableEvents = False
TByear.Value = ""
Me.EnableEvents = True
End Sub
Private Sub UserForm_Initialize()
Me.EnableEvents = True
'Clear tickboxes'
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "CheckBox" Then ctrl.Value = False
Next
'Fill CBmonth'
With Me.CBmonth
.AddItem "January"
.AddItem "February"
.AddItem "March"
.AddItem "April"
.AddItem "May"
.AddItem "June"
.AddItem "July"
.AddItem "August"
.AddItem "September"
.AddItem "October"
.AddItem "November"
.AddItem "December"
.AddItem "Select Month"
End With
CBmonth.ListIndex = 12
'Clear year'
TByear.Value = "yyyy"
End Sub
Bookmarks