Note: The input meal is data verified – it cannot be something that doesn’t exist on the lookup sheet. The sheets are all named, as are the named ranges.
An (Excel) user picks from meals available and then generates a shopping list PopulateShoppingList().
This takes the selections, looks them up on the applicable sheet, gathers the ingredients and ensures there aren’t duplicate ingredients.
I made some tweaks, refactored some of
I managed to get rid of my labels in
GetIngredients and managed to get the resizing of the array up one level of the code. Still, I feel like I’m missing some refactoring in
GetIngredients. Overall I made improvements but it seems like I made the code longer and did not manage to remove much abstraction – there are still 4
For Next loops
Option Explicit Public Sub PopulateShoppingList() Dim BreakfastArea As Range Set BreakfastArea = wsPlan.Range("BreakfastArea") Dim SnackAreaAM As Range Set SnackAreaAM = wsPlan.Range("SnacksAreaAM") Dim LunchArea As Range Set LunchArea = wsPlan.Range("LunchArea") Dim SnackAreaPM As Range Set SnackAreaPM = wsPlan.Range("SnacksAreaPM") Dim DinnerArea As Range Set DinnerArea = wsPlan.Range("DinnerArea") Dim ListArea As Range Set ListArea = wsPlan.Range("ListArea") ListArea.ClearContents Dim ingredientList As Variant ReDim ingredientList(1, 0) Dim mealList As Variant mealList = GetMealList(BreakfastArea) If Not IsEmpty(mealList) Then GetIngredients wsBreakfast, mealList, ingredientList mealList = GetMealList(LunchArea) If Not IsEmpty(mealList) Then GetIngredients wsLunch, mealList, ingredientList mealList = GetMealList(DinnerArea) If Not IsEmpty(mealList) Then GetIngredients wsDinner, mealList, ingredientList mealList = GetMealList(SnackAreaAM) If Not IsEmpty(mealList) Then GetIngredients wsSnacks, mealList, ingredientList mealList = GetMealList(SnackAreaPM) If Not IsEmpty(mealList) Then GetIngredients wsSnacks, mealList, ingredientList If Not IsEmpty(ingredientList(0, 0)) Then WriteShoppingList ingredientList End Sub Private Function GetMealList(ByVal targetArea As Range) As Variant Dim numberOfMeals As Long Dim listIndex As Long listIndex = 0 Dim meal As Range numberOfMeals = Application.WorksheetFunction.CountA(targetArea) If numberOfMeals = 0 Then Exit Function Dim mealList() As String ReDim mealList(numberOfMeals - 1) For Each meal In targetArea If Not meal = vbNullString Then mealList(listIndex) = meal.Value listIndex = listIndex + 1 End If Next GetMealList = mealList End Function Private Sub GetIngredients(ByVal targetSheet As Worksheet, ByVal mealList As Variant, ByRef ingredientList As Variant) Dim sheetRow As Long Dim mealIndex As Long Dim mealName As String Dim mealRow As Long Dim arrayIndex As Long Dim sheetLastRow As Long Dim mealLastRow As Long Dim expandBy As Long Dim newIngredient As Long With targetSheet sheetLastRow = .Cells(.Rows.count, 2).End(xlUp).Row For mealIndex = LBound(mealList) To UBound(mealList) mealName = mealList(mealIndex) For sheetRow = 2 To sheetLastRow If targetSheet.Cells(sheetRow, 1) = mealName Then mealLastRow = .Columns(1).Find(what:="*", after:=.Cells(sheetRow, 1), LookIn:=xlValues).Row If mealLastRow = 1 Then mealLastRow = .Columns(2).Find(what:=vbNullString, after:=.Cells(sheetRow, 2), LookIn:=xlValues).Row End If newIngredient = UBound(ingredientList, 2) expandBy = ExpandArray(.Range(.Cells(sheetRow, 2), .Cells(mealLastRow - 1, 2)), ingredientList) ReDim Preserve ingredientList(1, newIngredient + expandBy) For mealRow = sheetRow To mealLastRow - 1 If Not IsInArray(.Cells(mealRow, 2), ingredientList) Then ingredientList(0, newIngredient) = .Cells(mealRow, 2) ingredientList(1, newIngredient) = .Cells(mealRow, 3) newIngredient = newIngredient + 1 Else: For arrayIndex = LBound(ingredientList, 2) To newIngredient If ingredientList(0, arrayIndex) = .Cells(mealRow, 2) Then ingredientList(1, arrayIndex) = ingredientList(1, arrayIndex) + .Cells(mealRow, 3) Exit For End If Next arrayIndex End If Next mealRow End If Next sheetRow Next mealIndex End With End Sub Private Function ExpandArray(ByVal targetRange As Range, ByVal ingredientsList As Variant) As Long Dim count As Long Dim ingredient As Variant Dim newIngredient As Range For Each newIngredient In targetRange For Each ingredient In ingredientsList If ingredient = newIngredient Then GoTo Exists Next count = count + 1 Exists: Next newIngredient ExpandArray = count End Function Private Function IsInArray(ByVal ingredient As String, ByVal ingredientList As Variant) As Boolean Dim element As Variant For Each element In ingredientList If element = ingredient Then IsInArray = True Exit Function End If Next element IsInArray = False End Function Private Sub WriteShoppingList(ByVal ingredientList As Variant) Const LIST_FIRST_ROW As Long = 14 Const LIST_LAST_ROW As Long = 29 Const LIST_FIRST_COLUMN As Long = 2 Const LIST_LAST_COLUMN As Long = 8 Dim arrayIndex As Long Dim listItem As String arrayIndex = 0 Dim sheetRow As Long sheetRow = LIST_FIRST_ROW Dim columnIndex As Long columnIndex = LIST_FIRST_COLUMN For arrayIndex = LBound(ingredientList, 2) To UBound(ingredientList, 2) listItem = ingredientList(1, arrayIndex) & " " & ingredientList(0, arrayIndex) If sheetRow > LIST_LAST_ROW Then columnIndex = columnIndex + 1 sheetRow = LIST_FIRST_ROW If columnIndex > LIST_LAST_COLUMN Then Exit Sub End If wsPlan.Cells(sheetRow, columnIndex) = listItem sheetRow = sheetRow + 1 Next End Sub
✓ Extra quality
ExtraProxies brings the best proxy quality for you with our private and reliable proxies
✓ Extra anonymity
Top level of anonymity and 100% safe proxies – this is what you get with every proxy package
✓ Extra speed
1,ooo mb/s proxy servers speed – we are way better than others – just enjoy our proxies!
USA proxy location
We offer premium quality USA private proxies – the most essential proxies you can ever want from USA
Our proxies have TOP level of anonymity + Elite quality, so you are always safe and secure with your proxies
Use your proxies as much as you want – we have no limits for data transfer and bandwidth, unlimited usage!
Superb fast proxy servers with 1,000 mb/s speed – sit back and enjoy your lightning fast private proxies!
99,9% servers uptime
Alive and working proxies all the time – we are taking care of our servers so you can use them without any problems
No usage restrictions
You have freedom to use your proxies with every software, browser or website you want without restrictions
Perfect for SEO
We are 100% friendly with all SEO tasks as well as internet marketing – feel the power with our proxies
Buy more proxies and get better price – we offer various proxy packages with great deals and discounts
We are working 24/7 to bring the best proxy experience for you – we are glad to help and assist you!