Here is the first iteration of this project on CodeReview
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
This takes the selections, looks them up on the applicable sheet, gathers the ingredients and ensures there aren’t duplicate ingredients.
This all works, but I feel like doing
for each rng in rng isn’t the best thing. I also don’t like the way I’ve used labels in
GetIngredients, plus arrow-code there too.
I also create the array of ingredients in the
PopulateShoppingList() but I never use it there, I only pass it
ByRef to other procedures, which makes sense in my head, but I’m not sure how it looks in terms of code. Honestly, it’s been about 9 months since I’ve written any code at all.
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 mealSelection As Range Dim mealName As String Dim IngredientList As Variant ReDim IngredientList(1, 0) For Each mealSelection In BreakfastArea If Not mealSelection = vbNullString Then mealName = mealSelection.Value GetIngredients wsBreakfast, mealName, IngredientList End If Next For Each mealSelection In LunchArea If Not mealSelection = vbNullString Then mealName = mealSelection.Value GetIngredients wsLunch, mealName, IngredientList End If Next For Each mealSelection In DinnerArea If Not mealSelection = vbNullString Then mealName = mealSelection.Value GetIngredients wsDinner, mealName, IngredientList End If Next For Each mealSelection In SnackAreaAM If Not mealSelection = vbNullString Then mealName = mealSelection.Value GetIngredients wsSnacks, mealName, IngredientList End If Next For Each mealSelection In SnackAreaPM If Not mealSelection = vbNullString Then mealName = mealSelection.Value GetIngredients wsSnacks, mealName, IngredientList End If Next If IsEmpty(IngredientList(0, 0)) Then Exit Sub WriteShoppingList IngredientList End Sub 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 rowIndex As Long rowIndex = LIST_FIRST_ROW Dim columnIndex As Long columnIndex = LIST_FIRST_COLUMN With wsPlan For arrayIndex = LBound(IngredientList, 2) To UBound(IngredientList, 2) listItem = IngredientList(1, arrayIndex) & " " & IngredientList(0, arrayIndex) If rowIndex > LIST_LAST_ROW Then columnIndex = columnIndex + 1 rowIndex = LIST_FIRST_ROW If columnIndex > LIST_LAST_COLUMN Then Exit Sub End If .Cells(rowIndex, columnIndex) = listItem rowIndex = rowIndex + 1 Next End With End Sub Private Sub GetIngredients(ByVal targetSheet As Worksheet, ByVal mealName As String, ByRef IngredientList As Variant) Dim rowIndex As Long Dim mealIndex As Long Dim arrayIndex As Long Dim sheetLastRow As Long Dim mealLastRow As Long With targetSheet sheetLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row For rowIndex = 2 To sheetLastRow If targetSheet.Cells(rowIndex, 1) = mealName Then mealLastRow = .Columns(1).Find(what:="*", after:=.Cells(rowIndex, 1), LookIn:=xlValues).Row For mealIndex = rowIndex To mealLastRow - 1 If IsEmpty(IngredientList(0, 0)) Then GoTo Immediate For arrayIndex = LBound(IngredientList, 2) To UBound(IngredientList, 2) If IngredientList(0, arrayIndex) = .Cells(mealIndex, 2) Then IngredientList(1, arrayIndex) = IngredientList(1, arrayIndex) + .Cells(mealIndex, 3) GoTo NewIngredient End If Next arrayIndex ReDim Preserve IngredientList(1, UBound(IngredientList, 2) + 1) Immediate: IngredientList(0, UBound(IngredientList, 2)) = .Cells(mealIndex, 2) IngredientList(1, UBound(IngredientList, 2)) = .Cells(mealIndex, 3) NewIngredient: Next mealIndex Exit Sub End If Next rowIndex End With 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!