Hey guys, I'm new here and have a beginners questions. I have created a userform for data entry (code below). The form takes approximately 12 seconds to transfer the data to the spreadsheet. I have tried the recommendations in the following page https://www.mrexcel.com/forum/excel-questions/496915-slow-userform.html and in http://www.cpearson.com/Excel/SuppressChangeInForms.htm. However, the code still takes the same time. Any suggestions to improve performance?
'ENABLE EVENTS
Public EnableEvents As Boolean
Private Sub UserForm_Initialize()
'ENABLE EVENTS
Me.EnableEvents = True
'Populate combo boxex
Dim rngCapexForm As Range
Dim rngTCOForm As Range
Dim rngPowerPoint As Range
Dim rngQuotes As Range
Dim rngGartner As Range
Dim rngCapexStatus As Range
Dim rngFinanceStatus As Range
Dim ws As Worksheet
Set ws = Worksheets("Dropdown Lists")
For Each rngDepartment In ws.Range("Department")
Me.cboDepartment.AddItem rngDepartment.Value
Next rngDepartment
For Each rngCapexForm In ws.Range("YesNo")
Me.cboCapexForm.AddItem rngCapexForm.Value
Next rngCapexForm
For Each rngTCOForm In ws.Range("YesNo")
Me.cboTCOForm.AddItem rngTCOForm.Value
Next rngTCOForm
For Each rngPowerPoint In ws.Range("YesNo")
Me.cboPowerPoint.AddItem rngPowerPoint.Value
Next rngPowerPoint
For Each rngQuotes In ws.Range("YesNo")
Me.cboQuotes.AddItem rngQuotes.Value
Next rngQuotes
For Each rngGartner In ws.Range("Gartner")
Me.cboGartner.AddItem rngGartner.Value
Next rngGartner
For Each rngCapexStatus In ws.Range("Status")
Me.cboCapexStatus.AddItem rngCapexStatus.Value
Next rngCapexStatus
For Each rngFinanceStatus In ws.Range("Status")
Me.cboFinanceStatus.AddItem rngFinanceStatus.Value
Next rngFinanceStatus
End Sub
Private Sub cmdAddRequest_Click()
Application.ScreenUpdating = False
'DISABLE EVENTS
Me.EnableEvents = False
'Unprotects the "Requests" worksheet
ThisWorkbook.Worksheets("Requests").Unprotect Password:=""
'Check for request name
If Trim(Me.txtRequest.Value) = "" Then
MsgBox "Please enter the name of this request or project."
Me.txtRequest.SetFocus
Exit Sub
End If
'Validate Department form field
If cboDepartment.ListIndex < 0 Then
MsgBox "Please select the department name requesting this solution from the dropdown list."
Me.cboDepartment.SetFocus
Exit Sub
End If
'Check for Sponsor name
If Trim(Me.txtSponsor.Value) = "" Then
MsgBox "Please enter the name of the person sponsoring this request."
Me.txtSponsor.SetFocus
Exit Sub
End If
'Check for Project Manager name
If Trim(Me.txtProjectManager.Value) = "" Then
MsgBox "Please enter the name of the project manager assigned to this request." & Chr(10) & _
"If no PM is required, then enter the person in charge of this implementation."
Me.txtProjectManager.SetFocus
Exit Sub
End If
'Check for Cost Amount
If txtAmount.Value = "" Then
MsgBox "Please enter the total cost of this Capex request"
Me.txtAmount.SetFocus
Exit Sub
End If
'Validate Capex Request form field
If cboCapexForm.ListIndex < 0 Then
MsgBox "Please confirm if a Capex Form was done for this request."
Me.cboCapexForm.SetFocus
Exit Sub
End If
'Validate TCO form field
If cboTCOForm.ListIndex < 0 Then
MsgBox "Please confirm if a TCO Form was done for this request."
Me.cboTCOForm.SetFocus
Exit Sub
End If
'Validate PowerPoint form field
If cboPowerPoint.ListIndex < 0 Then
MsgBox "Please confirm if a PowerPoint was done for this request."
Me.cboPowerPoint.SetFocus
Exit Sub
End If
'Validate Quotes form field
If cboQuotes.ListIndex < 0 Then
MsgBox "Please confirm if there are quotations for this request."
Me.cboQuotes.SetFocus
Exit Sub
End If
'Validate Gartner form field
If cboGartner.ListIndex < 0 Then
MsgBox "Please confirm this request has been reviewed by Gartner." & Chr(10) & _
"Some small hardware and software purchases may not have to be reviewed by them. If this is the case then select N/A."
Me.cboGartner.SetFocus
Exit Sub
End If
'Check for a date in the Date field
If txtCapexMeetingDate = "" Then
MsgBox "Please enter the date of the next Capex meeting." & Chr(10) & "Format date as mm/dd/yy."
Me.txtCapexMeetingDate.SetFocus
Exit Sub
End If
'Validate Capex Status form field
If cboCapexStatus.ListIndex < 0 Then
MsgBox "Select the proper status for this Capex request."
Me.cboCapexStatus.SetFocus
Exit Sub
End If
'Check for person added By name
If Trim(Me.txtAddedBy.Value) = "" Then
MsgBox "Please enter the name of the person adding this request to the tracker."
Me.txtAddedBy.SetFocus
Exit Sub
End If
'---------------------------------------------------------------------------------------------------------
'Enter today's date in the Date field - THIS FIELD IS LOCKED AND ONLY SENDS THE DATA
txtDate.Text = Format(Date, "mm/dd/yy")
'---------------------------------------------------------------------------------------------------------
'Copy input values to sheet.
Dim oNewRow As ListRow
Dim Rng As Range
Set Rng = ThisWorkbook.Worksheets("Requests").Range("tblCapex")
Rng.Select
Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
With ws
oNewRow.Range.Cells(1, 2).Value = Me.txtRequest.Value
oNewRow.Range.Cells(1, 3).Value = Me.cboDepartment.Value
oNewRow.Range.Cells(1, 4).Value = Me.txtSponsor.Value
oNewRow.Range.Cells(1, 5).Value = Me.txtProjectManager.Value
oNewRow.Range.Cells(1, 6).Value = Me.cboGartner.Value
oNewRow.Range.Cells(1, 7).Value = Me.txtAmount.Value
oNewRow.Range.Cells(1, 8).Value = Me.cboCapexForm.Value
oNewRow.Range.Cells(1, 9).Value = Me.cboTCOForm.Value
oNewRow.Range.Cells(1, 10).Value = Me.cboPowerPoint.Value
oNewRow.Range.Cells(1, 11).Value = Me.cboQuotes.Value
oNewRow.Range.Cells(1, 12).Value = Me.txtCapexMeetingDate.Value
oNewRow.Range.Cells(1, 13).Value = Me.cboCapexStatus.Value
oNewRow.Range.Cells(1, 15).Value = Me.cboFinanceStatus.Value
oNewRow.Range.Cells(1, 18).Value = Me.txtDocsLink.Value
oNewRow.Range.Cells(1, 19).Value = Me.txtNotes.Value
oNewRow.Range.Cells(1, 20).Value = Me.txtAddedBy.Value
oNewRow.Range.Cells(1, 21).Value = Me.txtDate.Value
End With
'---------------------------------------------------------------------------------------------------------
'Clear the data
Me.txtRequest.Value = ""
Me.cboDepartment.Value = ""
Me.txtSponsor.Value = ""
Me.txtProjectManager.Value = ""
Me.txtAmount.Value = ""
Me.cboCapexForm.Value = ""
Me.cboTCOForm.Value = ""
Me.cboPowerPoint.Value = ""
Me.cboQuotes.Value = ""
Me.cboGartner.Value = ""
Me.txtCapexMeetingDate.Value = ""
Me.cboCapexStatus.Value = ""
Me.cboFinanceStatus.Value = ""
Me.txtDocsLink.Value = ""
Me.txtNotes.Value = ""
Me.txtAddedBy.Value = ""
Me.txtDate.Value = ""
'Set focus on the Request Name field for additional data entry
Me.txtRequest.SetFocus
Application.Goto Range("A" & ActiveCell.Row), False
Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select
'---------------------------------------------------------------------------------------------------------
'Format Hyperlinks
Dim WorkRng As Range
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = ThisWorkbook.Worksheets("Requests").Range("tblCapex[Documentation Link]")
For Each Rng In WorkRng
Application.ActiveSheet.Hyperlinks.Add Rng, Rng.Value
Next
For Each Rng In WorkRng
ThisWorkbook.Worksheets("Requests").Range ("tblCapex[Documentation Link]")
With Range("tblCapex[Documentation Link]")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Font.Color = vbBlue
.WrapText = True
End With
Next
'---------------------------------------------------------------------------------------------------------
'Protects the worksheet
ThisWorkbook.Worksheets("Requests").Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
Application.ScreenUpdating = True
'---------------------------------------------------------------------------------------------------------
'OPTIONAL - Close the form upon data submission to table
'Unload Me
'---------------------------------------------------------------------------------------------------------
'ENABLE EVENTS
Me.EnableEvents = True
End Sub
Private Sub cmdCloseForm_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
cmdCloseForm_Click
Cancel = True
MsgBox "Please use the Close Form button!"
End If
End Sub
'Format Request Date field
Private Sub txtCapexMeetingDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtCapexMeetingDate = Format(txtCapexMeetingDate, "mm/dd/yy")
End Sub
'Format Cost Amount field
Private Sub txtAmount_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtAmount.Value = Format(txtAmount.Value, "$#,##0.00")
End Sub
'ENABLE EVENTS
Public EnableEvents As Boolean
Private Sub UserForm_Initialize()
'ENABLE EVENTS
Me.EnableEvents = True
'Populate combo boxex
Dim rngCapexForm As Range
Dim rngTCOForm As Range
Dim rngPowerPoint As Range
Dim rngQuotes As Range
Dim rngGartner As Range
Dim rngCapexStatus As Range
Dim rngFinanceStatus As Range
Dim ws As Worksheet
Set ws = Worksheets("Dropdown Lists")
For Each rngDepartment In ws.Range("Department")
Me.cboDepartment.AddItem rngDepartment.Value
Next rngDepartment
For Each rngCapexForm In ws.Range("YesNo")
Me.cboCapexForm.AddItem rngCapexForm.Value
Next rngCapexForm
For Each rngTCOForm In ws.Range("YesNo")
Me.cboTCOForm.AddItem rngTCOForm.Value
Next rngTCOForm
For Each rngPowerPoint In ws.Range("YesNo")
Me.cboPowerPoint.AddItem rngPowerPoint.Value
Next rngPowerPoint
For Each rngQuotes In ws.Range("YesNo")
Me.cboQuotes.AddItem rngQuotes.Value
Next rngQuotes
For Each rngGartner In ws.Range("Gartner")
Me.cboGartner.AddItem rngGartner.Value
Next rngGartner
For Each rngCapexStatus In ws.Range("Status")
Me.cboCapexStatus.AddItem rngCapexStatus.Value
Next rngCapexStatus
For Each rngFinanceStatus In ws.Range("Status")
Me.cboFinanceStatus.AddItem rngFinanceStatus.Value
Next rngFinanceStatus
End Sub
Private Sub cmdAddRequest_Click()
Application.ScreenUpdating = False
'DISABLE EVENTS
Me.EnableEvents = False
'Unprotects the "Requests" worksheet
ThisWorkbook.Worksheets("Requests").Unprotect Password:=""
'Check for request name
If Trim(Me.txtRequest.Value) = "" Then
MsgBox "Please enter the name of this request or project."
Me.txtRequest.SetFocus
Exit Sub
End If
'Validate Department form field
If cboDepartment.ListIndex < 0 Then
MsgBox "Please select the department name requesting this solution from the dropdown list."
Me.cboDepartment.SetFocus
Exit Sub
End If
'Check for Sponsor name
If Trim(Me.txtSponsor.Value) = "" Then
MsgBox "Please enter the name of the person sponsoring this request."
Me.txtSponsor.SetFocus
Exit Sub
End If
'Check for Project Manager name
If Trim(Me.txtProjectManager.Value) = "" Then
MsgBox "Please enter the name of the project manager assigned to this request." & Chr(10) & _
"If no PM is required, then enter the person in charge of this implementation."
Me.txtProjectManager.SetFocus
Exit Sub
End If
'Check for Cost Amount
If txtAmount.Value = "" Then
MsgBox "Please enter the total cost of this Capex request"
Me.txtAmount.SetFocus
Exit Sub
End If
'Validate Capex Request form field
If cboCapexForm.ListIndex < 0 Then
MsgBox "Please confirm if a Capex Form was done for this request."
Me.cboCapexForm.SetFocus
Exit Sub
End If
'Validate TCO form field
If cboTCOForm.ListIndex < 0 Then
MsgBox "Please confirm if a TCO Form was done for this request."
Me.cboTCOForm.SetFocus
Exit Sub
End If
'Validate PowerPoint form field
If cboPowerPoint.ListIndex < 0 Then
MsgBox "Please confirm if a PowerPoint was done for this request."
Me.cboPowerPoint.SetFocus
Exit Sub
End If
'Validate Quotes form field
If cboQuotes.ListIndex < 0 Then
MsgBox "Please confirm if there are quotations for this request."
Me.cboQuotes.SetFocus
Exit Sub
End If
'Validate Gartner form field
If cboGartner.ListIndex < 0 Then
MsgBox "Please confirm this request has been reviewed by Gartner." & Chr(10) & _
"Some small hardware and software purchases may not have to be reviewed by them. If this is the case then select N/A."
Me.cboGartner.SetFocus
Exit Sub
End If
'Check for a date in the Date field
If txtCapexMeetingDate = "" Then
MsgBox "Please enter the date of the next Capex meeting." & Chr(10) & "Format date as mm/dd/yy."
Me.txtCapexMeetingDate.SetFocus
Exit Sub
End If
'Validate Capex Status form field
If cboCapexStatus.ListIndex < 0 Then
MsgBox "Select the proper status for this Capex request."
Me.cboCapexStatus.SetFocus
Exit Sub
End If
'Check for person added By name
If Trim(Me.txtAddedBy.Value) = "" Then
MsgBox "Please enter the name of the person adding this request to the tracker."
Me.txtAddedBy.SetFocus
Exit Sub
End If
'---------------------------------------------------------------------------------------------------------
'Enter today's date in the Date field - THIS FIELD IS LOCKED AND ONLY SENDS THE DATA
txtDate.Text = Format(Date, "mm/dd/yy")
'---------------------------------------------------------------------------------------------------------
'Copy input values to sheet.
Dim oNewRow As ListRow
Dim Rng As Range
Set Rng = ThisWorkbook.Worksheets("Requests").Range("tblCapex")
Rng.Select
Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
With ws
oNewRow.Range.Cells(1, 2).Value = Me.txtRequest.Value
oNewRow.Range.Cells(1, 3).Value = Me.cboDepartment.Value
oNewRow.Range.Cells(1, 4).Value = Me.txtSponsor.Value
oNewRow.Range.Cells(1, 5).Value = Me.txtProjectManager.Value
oNewRow.Range.Cells(1, 6).Value = Me.cboGartner.Value
oNewRow.Range.Cells(1, 7).Value = Me.txtAmount.Value
oNewRow.Range.Cells(1, 8).Value = Me.cboCapexForm.Value
oNewRow.Range.Cells(1, 9).Value = Me.cboTCOForm.Value
oNewRow.Range.Cells(1, 10).Value = Me.cboPowerPoint.Value
oNewRow.Range.Cells(1, 11).Value = Me.cboQuotes.Value
oNewRow.Range.Cells(1, 12).Value = Me.txtCapexMeetingDate.Value
oNewRow.Range.Cells(1, 13).Value = Me.cboCapexStatus.Value
oNewRow.Range.Cells(1, 15).Value = Me.cboFinanceStatus.Value
oNewRow.Range.Cells(1, 18).Value = Me.txtDocsLink.Value
oNewRow.Range.Cells(1, 19).Value = Me.txtNotes.Value
oNewRow.Range.Cells(1, 20).Value = Me.txtAddedBy.Value
oNewRow.Range.Cells(1, 21).Value = Me.txtDate.Value
End With
'---------------------------------------------------------------------------------------------------------
'Clear the data
Me.txtRequest.Value = ""
Me.cboDepartment.Value = ""
Me.txtSponsor.Value = ""
Me.txtProjectManager.Value = ""
Me.txtAmount.Value = ""
Me.cboCapexForm.Value = ""
Me.cboTCOForm.Value = ""
Me.cboPowerPoint.Value = ""
Me.cboQuotes.Value = ""
Me.cboGartner.Value = ""
Me.txtCapexMeetingDate.Value = ""
Me.cboCapexStatus.Value = ""
Me.cboFinanceStatus.Value = ""
Me.txtDocsLink.Value = ""
Me.txtNotes.Value = ""
Me.txtAddedBy.Value = ""
Me.txtDate.Value = ""
'Set focus on the Request Name field for additional data entry
Me.txtRequest.SetFocus
Application.Goto Range("A" & ActiveCell.Row), False
Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select
'---------------------------------------------------------------------------------------------------------
'Format Hyperlinks
Dim WorkRng As Range
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = ThisWorkbook.Worksheets("Requests").Range("tblCapex[Documentation Link]")
For Each Rng In WorkRng
Application.ActiveSheet.Hyperlinks.Add Rng, Rng.Value
Next
For Each Rng In WorkRng
ThisWorkbook.Worksheets("Requests").Range ("tblCapex[Documentation Link]")
With Range("tblCapex[Documentation Link]")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Font.Color = vbBlue
.WrapText = True
End With
Next
'---------------------------------------------------------------------------------------------------------
'Protects the worksheet
ThisWorkbook.Worksheets("Requests").Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
Application.ScreenUpdating = True
'---------------------------------------------------------------------------------------------------------
'OPTIONAL - Close the form upon data submission to table
'Unload Me
'---------------------------------------------------------------------------------------------------------
'ENABLE EVENTS
Me.EnableEvents = True
End Sub
Private Sub cmdCloseForm_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
cmdCloseForm_Click
Cancel = True
MsgBox "Please use the Close Form button!"
End If
End Sub
'Format Request Date field
Private Sub txtCapexMeetingDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtCapexMeetingDate = Format(txtCapexMeetingDate, "mm/dd/yy")
End Sub
'Format Cost Amount field
Private Sub txtAmount_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtAmount.Value = Format(txtAmount.Value, "$#,##0.00")
End Sub