0
\$\begingroup\$

first time

second time

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 PopulateShoppingList(), added GetMealList, ExpandArray and IsInArray.

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
\$\endgroup\$
5
  • \$\begingroup\$ @ThomasInzina not entirely sure what you mean, but I'm more than open to discussion on everything, in the issues of the github project. Current code is in the v2Reworking Template.xlsm not in main branch. \$\endgroup\$ Feb 5 '18 at 22:18
  • \$\begingroup\$ v2Reworking Template.xlsm set up is much better. I would take it a step further by combining the meal worksheets into 1 using another field to indicate the meal. But your way would is probably easy for the typical user to understand. \$\endgroup\$
    – user109261
    Feb 5 '18 at 23:05
  • \$\begingroup\$ @ThomasInzina I have thought about dictionaries for getting uniques, but it ends up being a mess for totaling duplicates. I don't want to combine the meal tabs because that's another field I'd need to do a lookup on, in case there are duplicate meals with different ingredients, like waffles for breakfast vs waffles for dinner. I've thought of using a Class and then a collection of classes, but I've not tried it. \$\endgroup\$ Feb 5 '18 at 23:24
  • \$\begingroup\$ Neat project, thanks for sharing. I think making a relational database here would managing the data easier. Are you trying to keep this in Excel to keep it easy for users? \$\endgroup\$ Feb 6 '18 at 14:30
  • \$\begingroup\$ @ryan yeah, exactly - excel because that's where it started, and I'm only really expanding it because I've been getting requests from users \$\endgroup\$ Feb 6 '18 at 21:09
0
\$\begingroup\$

So I was reworking this and came across a few things -

Readability can be improved by renaming some variables in GetIngredients:

 ingredient = .Cells(mealRow, 2)
 quantity = .Cells(mealRow, 3)

Using these instead of the cell makes it much easier to follow.

Also renamed

 sheetRow to currentRow
 mealIndex to listIndex

This also improved readability.


Refactoring GetIngredients

Again, looking back over this I had some comments to myself -

With targetSheet
    sheetLastRow = .Cells(.Rows.count, 2).End(xlUp).Row
    
    'Set meal
    For listIndex = LBound(mealList) To UBound(mealList)
        mealName = mealList(listIndex)
        
        For currentRow = 2 To sheetLastRow
            
            'Find meal, if found EXIT THIS LOOP
            If targetSheet.Cells(currentRow, 1) = mealName Then
                
                'Find end of meal
                mealLastRow = .Columns(1).Find(what:="*", after:=.Cells(currentRow, 1), LookIn:=xlValues).Row

                'not sure
                If mealLastRow = 1 Then
                    mealLastRow = .Columns(2).Find(what:=vbNullString, after:=.Cells(currentRow, 2), LookIn:=xlValues).Row
                End If
                '??
                'current upper bound
                newIngredient = UBound(ingredientList, 2)
                
                'expand array to include if it doesn't exist. Why can't I use this as the next loop if?
                expandBy = ExpandArray(.Range(.Cells(currentRow, 2), .Cells(mealLastRow - 1, 2)), ingredientList)
                'expand upper bound by count, count can be 0
                ReDim Preserve ingredientList(1, newIngredient + expandBy)

                'Get ingredient
                For mealRow = currentRow To mealLastRow - 1
                    ingredient = .Cells(mealRow, 2)
                    quantity = .Cells(mealRow, 3)
                    
                    'is in list?
                    If Not IsInArray(ingredient, ingredientList) Then
                        'no, add to list
                        ingredientList(0, newIngredient) = ingredient
                        ingredientList(1, newIngredient) = quantity
                        newIngredient = newIngredient + 1
                    Else:
                    'yes, increase quantity of existing
                        For arrayIndex = LBound(ingredientList, 2) To newIngredient
                            If ingredientList(0, arrayIndex) = ingredient Then
                                ingredientList(1, arrayIndex) = ingredientList(1, arrayIndex) + quantity
                                Exit For
                            End If
                        Next arrayIndex
                    End If
                Next mealRow
            End If
        'why keep looking for something if found?
        Next currentRow
    Next listIndex
End With

It seems I'm doing the same checking in ExpandBy as I am in IsInArray.

It also seems that once I find the meal and populate the ingredients, I continue to iterate through the rest of the sheet, for no reason.

That's sloppy. Why wouldn't I find the ingredient, check in the array then decide to expand the array if it isn't already there?

I also have no idea what the goal of this is -

 If mealLastRow = 1 Then
    mealLastRow = .Columns(2).Find(what:=vbNullString, after:=.Cells(currentRow, 2), LookIn:=xlValues).Row
 End If

At what point will mealLastRow end at 1 when the loop looking for it starts at 2? Maybe there's a bug I don't recognize anymore, but for now I have no idea what that is.

It seems the logical way to do this would be

  1. Find the meal on the list
  2. Get meal range, find ingredients
  3. Look for ingredients in the ingredient array
    3a. If found, increase quantity
    3b. If not, expand array and add

E.g

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

Public Sub GetIngredients(ByVal targetSheet As Worksheet, ByVal mealList As Variant, ByRef IngredientList As Variant)
    Dim mealIngredients As Variant
    Dim quantity As Long
    Dim ingredient As String
    Dim listIndex As Long
    Dim listPosition As Long
    Dim mealName As String
    Dim mealIndex As Long

    For listIndex = LBound(mealList) To UBound(mealList)
        mealName = mealList(listIndex)
         mealIngredients = FindMeal(mealName, targetSheet)
        For mealIndex = 1 To UBound(mealIngredients)
            ingredient = mealIngredients(mealIndex, 1)
            quantity = mealIngredients(mealIndex, 2)
            listPosition = IngredientPosition(ingredient, IngredientList)
                
            If listPosition = 0 Then
                ReDim Preserve IngredientList(1, UBound(IngredientList, 2) + 1)
                IngredientList(0, UBound(IngredientList, 2)) = ingredient
                IngredientList(1, UBound(IngredientList, 2)) = quantity
            ElseIf listPosition < 0 Then
                IngredientList(0, listPosition + 2) = ingredient
                IngredientList(1, listPosition + 2) = quantity
            Else
                IngredientList(1, listPosition) = IngredientList(1, listPosition) + quantity
            End If
        Next
    Next listIndex

End Sub

Private Function FindMeal(ByVal mealName As String, ByVal targetSheet As Worksheet) As Variant
    Dim lastRow As Long
    Dim currentRow As Long
    Dim mealLastRow As Long
    With targetSheet
        lastRow = targetSheet.Cells(targetSheet.Rows.count, 2).End(xlUp).Row
        For currentRow = 2 To lastRow
            If targetSheet.Cells(currentRow, 1) = mealName Then
                mealLastRow = .Columns(1).Find(what:="*", after:=.Cells(currentRow, 1), LookIn:=xlValues).Row
                FindMeal = .Range(.Cells(currentRow, 2), .Cells(mealLastRow - 1, 3))
                Exit Function
            End If
        Next
    End With
End Function

Private Function IngredientPosition(ByVal ingredient As String, ByRef IngredientList As Variant) As Long
    If IsEmpty(IngredientList(0, 0)) Then
        IngredientPosition = -2
        Exit Function
    ElseIf IsEmpty(IngredientList(0, 1)) Then
        IngredientPosition = -1
        Exit Function
    Else
        IngredientPosition = 0
    End If

    Dim i As Long
    For i = LBound(IngredientList, 2) To UBound(IngredientList, 2)
        If IngredientList(0, i) = ingredient Then
            IngredientPosition = i
            Exit Function
        End If
    Next

End Function
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.