Why does it take so long to print values from userform to sheet?

Question

I have a userform with around 20 controls in that can be inputted. Some are textboxes some are comboboxes etc.

The user fills in these controls and then hits save. When save is pressed, the code finds the relevant row number (based on the task number generated in userform e.g. 1.04 will find 1.03 and add row below.)

However, it can take around 10 seconds or more to fill the newly inserted/copied row, which is impractical for something that will be used frequently.

Is there any efficiencies or alternatives i could use? Sorry I am a newbie to this sort of thing!

I have also included a screen shot which shows the user form, as well as the column where the value is searched before adding a row. The screenshot also shows example of the columns included in the spreadsheet.

image 1

image 2

userform image

Private Sub CommandButtonSave_Click()
Application.ScreenUpdating = False
Application.Calculation = xlManual
'Declare variables
Dim subtaskws As Worksheet: Set subtaskws = ThisWorkbook.Sheets("Sub Tasks")
Dim ActivityWs As Worksheet: Set ActivityWs = ThisWorkbook.Sheets("Activity Overview")
Dim lastrow As Long, lastrowAO As Long, cellinput As Variant, newrow As Long, lastcollet As String, lastcol As Long, findtasknum As Range, lastrowST As Long, cell As Range, found As Variant, activitynum As Long
'Find column Letters
Call ColumnLetterFinder(subtaskws, 2, "Actual Workload", AWCol)
Call ColumnLetterFinder(subtaskws, 2, "W.", WCol)
Call ColumnLetterFinder(subtaskws, 2, "I.", ICol)
Call ColumnLetterFinder(subtaskws, 2, "E.", ECol)
Call ColumnLetterFinder(subtaskws, 2, "P", PCol)
Call ColumnLetterFinder(subtaskws, 2, "Level", LevelCol)
'find lastrows, columns and cells
lastrow = (subtaskws.Range("A" & Rows.Count).End(xlUp).row) + 1
lastcol = subtaskws.Cells(2, 1).End(xlToRight).Column
lastcollet = lastcol
lastcollet = Split(Cells(1, lastcol).Address, "$")(1)
lastrowST = subtaskws.Range("A" & Rows.Count).End(xlUp).row
activitynum = AddTask.TextBoxid.Value + 1
Dim Ctrl As Variant, range1 As Range, userformorder As Variant, col As Long, IDrange() As Variant
userformorder = Array("SubTaskID", "TextBoxsubtask", "ComboBoxDeliverableFormat", "TextBoxcheckedcomplete", "TextBoxformat", "TextBoxacceptancecriteria", "BudgetWorkloadTextBox", "AWLTextBox", "ComboBoxOwner", "TextBoxTDSNumber", "TextBoxMilestone", "TextBoxTargetDeliveryDate", "ComboBoxW", "ComboBoxI", "ComboBoxe", "TextBoxP", "TextBoxLevel", "TextBoxInputQuality", "TextBoxNewInput", "TextBoxDelay", "TextBoxInternalVV", "TextBoxReviewer", "TextBoxDelivered", "ComboBoxNumIterations", "ComboBoxAcceptance", "ComboBoxProgress", "ComboBoxStatus", "ComboBoxFlowChart", "TextBoxActivitySheet", "TextBoxEvidenceofDelivery", "TextBoxComments") 'etc
'Find row before subtaskId number
Set found = subtaskws.Range("A3:A" & lastrowST).Find(What:=(activitynum), LookAt:=xlWhole)
If found Is Nothing Then
 newrow = lastrow
subtaskws.Range("A4:A" & lastcollet).EntireRow.Copy
subtaskws.Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
subtaskws.Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
subtaskws.Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
subtaskws.Range("A" & newrow & ":AE" & newrow & "").ClearContents
subtaskws.Columns("A:BB").Calculate
For Each Ctrl In userformorder
If col = 8 Then
Else
 If AddTask.Controls(Ctrl).Value <> "" Then
 subtaskws.Range("A" & newrow).Offset(, col).Value = AddTask.Controls(Ctrl).Value
 End If
col = col + 1
End If
Next Ctrl
subtaskws.Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
subtaskws.Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
subtaskws.Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
Else
 subtaskws.Range("A" & (found.row)).EntireRow.Insert
 newrow = found.row - 1
 subtaskws.Range("A4:A" & lastcollet & "").EntireRow.Copy
 subtaskws.Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
 subtaskws.Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
 subtaskws.Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
 subtaskws.Range("A" & newrow & ":AE" & newrow & "").ClearContents
For Each Ctrl In userformorder
 If AddTask.Controls(Ctrl).Value <> "" Then
 subtaskws.Range("A" & newrow).Offset(, col).Value = AddTask.Controls(Ctrl).Value
 End If
col = col + 1
Next Ctrl
subtaskws.Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
subtaskws.Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
subtaskws.Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
End If
 TextBoxsubtask.Value = vbNullString
 ComboBoxDeliverableFormat.Value = vbNullString
 TextBoxformat.Value = vbNullString
 ComboBoxOwner.Value = vbNullString
 TextBoxTargetDeliveryDate.Value = vbNullString
 ComboBoxW.Value = vbNullString
 ComboBoxI.Value = vbNullString
 ComboBoxe.Value = vbNullString
 TextBoxP.Value = vbNullString
 TextBoxLevel.Value = vbNullString
 TextBoxComments.Value = Null
 TextBoxEvidenceofDelivery.Value = Null
 TextBoxActivitySheet.Value = Null
 ComboBoxFlowChart.Value = Null
 ComboBoxStatus.Value = Null
 ComboBoxProgress.Value = Null
 ComboBoxAcceptance.Value = Null
 ComboBoxNumIterations.Value = Null
 TextBoxDelivered.Value = Null
 TextBoxReviewer.Value = Null
 TextBoxInternalVV.Value = Null
 TextBoxDelay.Value = Null
 TextBoxNewInput.Value = Null
 TextBoxInputQuality.Value = Null
 TextBoxMilestone.Value = Null
 TextBoxTDSNumber.Value = Null
 TextBoxacceptancecriteria.Value = Null
 TextBoxcheckedcomplete.Value = Null
 SubTaskID.Value = SubTaskID.Value + 0.01
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Public Function ColumnLetterFinder(ws, row, Value, x)
Dim rFind As range
 With ws.Rows(row)
 Set rFind = .Find(What:=Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
 If Not rFind Is Nothing Then
 x = Split(rFind.Address, "$")(1)
 End If
 End With
End Function

• TinMan: You should include ColumnLetterFinder and some screenshots of thedata and formats. I download link with mock data would also help.
• Lawrence Forster: Sorry these have been added now!
• TinMan: Sorry about the slow response. Is ColumnLetterFinder() really necessary? Will the users be reordering the columns? Or are you using it to make your code more dynamic, in case you plan on changing the column order yourself?
• Lawrence Forster: Yes unfortunately as the extra columns may be added in depending on the project. The columns included now and the vital ones

Answer 1

I don't see anything wrong so just a few shots in the dark:

Are there any "hidden" data-driven automations like worksheet_change or whatever?

You may disable event handling and a few more time comsuming services for the course of processing. Take a look at this: Speed up App

I would not apply copying validations and formats and whatever on all the 16K cells in the entire row. It's OK to manage a dynamically changing number of columns but I'd rather maximize the number of columns with calculating the exact number of used columns (more hassle) or simply setting it to say 100 if you'd never have more than 80 (quick and dirty).

Checking a string for zero length it is somewhat faster to use

If LenB(AddTask.Controls(Ctrl).Value) <> 0 ...

instead of

If AddTask.Controls(Ctrl).Value <> "" ...

for it does not invoke string comparision function but checks a single byte in the string header.

+1: For manipulating formulas run-time I prefer using .Cells this way

subtaskws.FormulaLocal="=sum(" & Range(CElls(newrow, "AF"), Cells(newrow, lastcollet)).Address & ")"

for it is more handy than bothering with string concatenations to make cell references. See also .FormulaLocal and .Address(False, False)

• Lawrence Forster: Thanks for the feedback! i never knew about forumla local so that could be really handy! thanks

Answer 2

I am going to address some style issues.

Do not compress lines

Yes, the syntax allows you to write code like:

Dim subtaskws As Worksheet: Set subtaskws = ThisWorkbook.Sheets("Sub Tasks")

But it is harder to read and the assignment versus declaration is harder to see. This makes code harder to follow and maintain. Instead, be clear and explicit:

Dim subtaskws As Worksheet 
Set subtaskws = ThisWorkbook.Sheets("Sub Tasks")

The use of the ':' is useful in command line basic (or when doing some things in the immediate window). It is not good in modules.

Use code names (named sheets)

In the VBA Editor, you can rename the 'Sheet1' name of the sheets to something meaningful. Let us say, for example, that you change the (Name) of the sheets to 'SubTasks'. The following image is an example I have - different names but you should get the idea.

enter image description here

Now the code

Dim subtaskws As Worksheet 
Set subtaskws = ThisWorkbook.Sheets("Sub Tasks")

is no longer necessary, and you can jump straight into

lastcol = SubTasks.Cells(2, 1).End(xlToRight).Column

Do not use Call

This is debated - Call is an obsolete word for backwards compatibility, but if anyone needs backwards compatibility to when Call was necessary, they have much bigger issues!

But you have really exemplified why using the obsolete and unnecessary token is not good. You have completely misused a function call (see next comment)!

At this point I am going to say:

Call ColumnLetterFinder(subtaskws, 2, "Actual Workload", AWCol)

should be idiomatic VBA:

ColumnLetterFinder subtaskws, 2, "Actual Workload", AWCol

Functions should return things

Your function, written as a Function does not return anything. From your description it is intended to return a string representing the name of a column. There are other ways of doing this, or achieving the result you want. But, for the purposes of this answer I am going to focus on the Function.

Public Function ColumnLetterFinder(ws, row, Value, x)

does not declare a return type, does not strongly type the inputs, nor does it exercise discipline in mutating values (by value, rather than by the implicit reference).

Public Function ColumnLetterFinder(ByVal ws As Worksheet, ByVal row As Long, ByVal Value As String, ByRef x As String) As String

Note: I made the last one explicitly ByRef because your current code changes that value.

Of course, what you are implicitly doing, is returning the answer through x. So, we can tidy this up a bit:

Public Function ColumnLetterFinder(ByVal ws As Worksheet, ByVal row As Long, ByVal Value As String) As String
Dim rFind As range
 With ws.Rows(row)
 Set rFind = .Find(What:=Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
 If Not rFind Is Nothing Then
 ColumnLetterFinder = Split(rFind.Address, "$")(1) '<--- set the return value here
 End If
 End With
End Function ' Default value for string is "" if rFind is nothing

Now your main code can definitely get rid of that annoying Call:

AWCol = ColumnLetterFinder(subtaskws, 2, "Actual Workload")

... or if you have names the sheet as suggested before:

AWCol = ColumnLetterFinder(SubTasks, 2, "Actual Workload")

Now the code pretty much comments itself!

Standard comments

Use Option Explict at the top of modules. Always. Always.

Properly indent your code. This makes it easier to read and easier to spot where logic should be. An out of place If or loop becomes easier to spot.

Use meaningful variable names every time. Yes, it is sometimes hard to figure out a good name, but you will thank yourself in the months to come. After all, what did 'x' mean?