Excel userform takes too long to process the data

[cpereznj]

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

 

[Herodotus07]

Did you try the two suggestions I had in the post above my last? (I double-posted, so I may have snuck it by ya).

 

[cpereznj]

Two things to try first to reduce the 18 second lag. I see you are looping through the Documentation Link column twice. If you have a substantial amount of entries here, performing edits on each range can eat up time. Try:

1. Group all of the manipulations into one loop.

For Each Rng In WorkRng
        Application.ActiveSheet.Hyperlinks.Add Rng, Rng.Value
        With Rng
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .Font.Color = vbBlue
            .WrapText = True
        End With
    Next

2. Do the old entries already have links in them? If so, why would you update the link? (I might be missing something, since I don't know what's in your spreadsheet). If there's no sense in updating the link, try only adding the link for the recently added item. If something else is going on, let me know.



As for the smaller lag between 3 and 4, it seems strange that its taking so long, as there isn't that much data being added. Is this being entered into a sheet table? Or just a range of cells?

I tried the code and it helped improve the performance. It now takes approximately 10-12 seconds to add the data to the table in the spreadsheet.
Regarding your second question, the old entries already have the cells formatted as hyperlinks. I don't know how to just add the new data and format it as hyperlink. Any suggestions?

 

[Herodotus07]

It now takes approximately 10-12 seconds to add the data to the table in the spreadsheet.

Ha, progress! But not good enough yet.
For the hyperlink, I presume it is just a column in, or to the right, of all the data that you just entered, correct? If that's the case, why not add the hyperlink in your With ws section? I'm making an assumption about where your data link is, but take this for example:

'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

Application.ActiveSheet.Hyperlinks.Add oNewRow.Range.Cells(1, 18), oNewRow.Range.Cells(1, 18).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



With oNewRow.Range.Cells(1, 18)
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Font.Color = vbBlue
.WrapText = True
End With

Maybe try something like this first. As to the other lag, I had a thought on that, but I can't test it out, or be sure it will work. Regardless: In your data entry section, is there really a need to throw all that in a With group? You've already defined oNewRow as a range, there shouldn't be a need to group that in a With EndWith. Plus, the way is stands, I'm not sure its even making a difference. In a With group, you typically have to start each line with a period, but all of your lines are lacking a leading "." I wonder if its causing some of the lag. Maybe get rid of the With grouping on that data entry section. Again, just a whim, something to try. Lemme know if there's any improvement.

 

[cpereznj]

[MENTION]Herodotus7[/MENTION]The last change really improved things a lot. It is down to 3-4 seconds to process the data which isn't too bad. I think I'll close this thread now. Thanks for all your help.