Adding meals to list on Worksheet, from UserForm

Question

As you may know, this is an ongoing thing 1 2 3

I've created a form that pops up when a user wants to add a new meal to the meal plan.

enter image description here

The UI is pretty terrible, but what I'm running into is when the Create Meal button is pressed, everything works fine, but it seems to hang.

It's taking longer than it should. Right now adding a meal takes nearly 4 seconds. I find this ridiculous unless somehow I've hit the limits of VBA, which seems impossible.

The Form Code -

Option Explicit
Private Sub CloseForm_Click()
 Unload Me
End Sub
Public Sub UserForm_Initialize()
 Const SELECTION_LIST_DELIMITED As String = "Breakfast,Lunch,Dinner,Snack"
 Const DELIMITER As String = ","
 MealTypeSelection.List = Split(SELECTION_LIST_DELIMITED, DELIMITER)
End Sub
Private Sub IngredientAmtSpin_SpinDown()
 If Not NewIngredientAmount.Value < 2 Then
 NewIngredientAmount.Value = Val(NewIngredientAmount.Value) - 1
 End If
End Sub
Private Sub IngredientAmtSpin_SpinUp()
 NewIngredientAmount.Value = Val(NewIngredientAmount.Value) + 1
End Sub
Private Sub AddIngredient_Click()
 If NewIngredient.Value = vbNullString Or Not IsNumeric(NewIngredientAmount.Value) Then Exit Sub
 If NewIngredientAmount.Value < 1 Then NewIngredientAmount.Value = 1
 Dim ingredient As String
 ingredient = NewIngredient.Value
 Dim IngredientAmount As Long
 IngredientAmount = Int(NewIngredientAmount.Value)
 IngredientList.AddItem ingredient
 IngredientList.List(IngredientList.listCount - 1, 1) = IngredientAmount
 NewIngredient.Value = vbNullString
 NewIngredientAmount.Value = 1
End Sub
Private Sub ClearIngredientList_Click()
 IngredientList.Clear
End Sub
Private Sub CreateMealButton_Click()
 Dim begin As Double
 Dim total As Double
 begin = Timer
 Dim mealType As String
 If MealTypeSelection.Text = vbNullString Then
 MsgBox "Please select a meal type."
 Exit Sub
 Else: mealType = MealTypeSelection.Text
 End If
 If Not NewIngredient.Value = vbNullString Then
 MsgBox "Did you forget to add an ingredient to the list?"
 Exit Sub
 End If
 Dim mealName As String
 mealName = StrConv(MealNameBox.Value, vbProperCase)
 Dim targetSheet As Worksheet
 Select Case mealType
 Case "Breakfast"
 Set targetSheet = wsBreakfast
 Case "Lunch"
 Set targetSheet = wsLunch
 Case "Dinner"
 Set targetSheet = wsDinner
 Case "Snack"
 Set targetSheet = wsSnacks
 End Select
 Dim lastRow As Long
 lastRow = targetSheet.Cells(targetSheet.Rows.count, 2).End(xlUp).Row
 If MealExists(targetSheet, lastRow, mealName) Then
 MsgBox "Meal name already exists. Meal not created."
 Exit Sub
 End If
 Dim listCount As Long
 listCount = IngredientList.listCount
 If listCount = 0 Then
 MsgBox "No ingredients entered"
 Exit Sub
 End If
 Dim listOfIngredients() As String
 ReDim listOfIngredients(1 To listCount, 1)
 Dim index As Long
 For index = LBound(listOfIngredients) To UBound(listOfIngredients)
 listOfIngredients(index, 0) = StrConv(IngredientList.List(index - 1, 0), vbProperCase)
 listOfIngredients(index, 1) = StrConv(IngredientList.List(index - 1, 1), vbProperCase)
 Next
 MakeMeal targetSheet, lastRow + 1, mealName, listOfIngredients
 If KeepActive.Value = True Then
 IngredientList.Clear
 MealNameBox.Value = vbNullString
 Else
 Unload Me
 End If
 total = Round(Timer - begin, 2)
 Debug.Print total
End Sub
Private Function MealExists(ByVal targetSheet As Worksheet, ByVal lastRow As Long, ByVal mealName As String) As Boolean
 MealExists = False
 Dim rowNumber As Long
 For rowNumber = 1 To lastRow
 If targetSheet.Cells(rowNumber, 1) = mealName Then
 MealExists = True
 Exit Function
 End If
 Next
End Function
Private Sub MakeMeal(ByVal targetSheet As Worksheet, ByVal lastRow As Long, ByVal mealName As String, ByVal listOfIngredients As Variant)
 targetSheet.Cells(lastRow, 1) = mealName
 Dim index As Long
 For index = LBound(listOfIngredients) To UBound(listOfIngredients)
 targetSheet.Cells(lastRow + index - 1, 2) = listOfIngredients(index, 0)
 targetSheet.Cells(lastRow + index - 1, 3) = listOfIngredients(index, 1)
 Next
End Sub

The part that hangs is the CreateMealButton_Click(). I've included the timer. There's a bunch of other code doing other stuff, but none of it interacts with the form.

All the objects' names pretty much describe what they actually are, but the actual book can be downloaded from github

Experimental branch

Answer 1

The reason for the slow down are the Array Formulas. They are evaluating millions of extra cells.

=IFERROR(INDEX($A:$A,SMALL(IF($A:$A<>"",ROW($A:$A)-ROW($A1ドル)+1),ROW())),"")

By creating 4 Dynamic Named Ranges I was able to rework the Array Formulas, so that the Meals post virtually instantaneously. The workbook also opens much faster.

New Defined Names:

• BreakFast_Meal_Name:

  =OFFSET(BreakfastSheet!$A1,1,0,ドルCOUNTA(BreakfastSheet!$B:$B)-1,1)

• Dinner_Meal_Name:

  =OFFSET(DinnerSheet!$A1,1,0,ドルCOUNTA(DinnerSheet!$B:$B)-1,1)

• Lunch_Meal_Names:

  =OFFSET(LunchSheet!$A1,1,0,ドルCOUNTA(LunchSheet!$B:$B)-1,1)

• Snack_Meal_Name:

  =OFFSET(SnacksSheet!$A1,1,0,ドルCOUNTA(SnacksSheet!$B:$B)-1,1)

New Array Formulas:

=IFERROR(INDEX(BreakFast_Meal_Name,SMALL(IF(BreakFast_Meal_Name<>"",ROW(BreakFast_Meal_Name)-ROW($A2ドル)+1),ROW())),"")
=IFERROR(INDEX(Lunch_Meal_Names,SMALL(IF(Lunch_Meal_Names<>"",ROW(Lunch_Meal_Names)-ROW($A2ドル)+1),ROW())),"")
=IFERROR(INDEX(Dinner_Meal_Name,SMALL(IF(Dinner_Meal_Name<>"",ROW(Dinner_Meal_Name)-ROW($A2ドル)+1),ROW())),"")
=IFERROR(INDEX(Snack_Meal_Name,SMALL(IF(Snack_Meal_Name<>"",ROW(Snack_Meal_Name)-ROW($A2ドル)+1),ROW())),"")

AddIngredient_Click:Button Event

I see no reason for the intermediate variables in AddIngredient_Click. The control names are meaningful enough. I would prepend TextBox names with txt. I also recommend Proper Casing the ingredients when you add them to the Listbox, instead of doing it when you add them to the worksheet

Private Sub AddIngredient_Click()
 If NewIngredient.Value = vbNullString Or Not IsNumeric(NewIngredientAmount.Value) Then
 MsgBox "Both Ingredient and Amount are Required Fields", vbInformation, "Try Again"
 Exit Sub
 End If
 If Int(NewIngredientAmount.Value) < NewIngredientAmount.Value Then
 MsgBox "Amount can not be less then 0 and Fractions are not Allowed", vbInformation, "Try Again"
 Exit Sub
 End If
 IngredientList.AddItem StrConv(NewIngredient.Value, vbProperCase)
 IngredientList.List(IngredientList.listCount - 1, 1) = NewIngredientAmount.Value
 NewIngredient.Value = vbNullString
 NewIng

• Raystafarian: When did you become narcissistic? Also, thanks - let me digest this answer
• Raystafarian: That array formula stuff is great, the reason it was so convoluted is because my data validation on PlanSheet shows empties otherwise.
• Raystafarian: And I'm 100% on board with my button event, it was overthought, thanks
• user109261: I've been narcissistic my whole life..lol.
• Raystafarian: Yikes. Well, you take criticism pretty well for a narcissist.. The only way I can think of fixing the data validation would be reworking the formulas in a worksheet_change event.