3
\$\begingroup\$

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 PopulateShoppingList().

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
\$\endgroup\$
5
\$\begingroup\$

The repeated loops jumped at me first.

For Each mealSelection In SOME_RANGE
    If Not mealSelection = vbNullString Then
        mealName = mealSelection.Value
        GetIngredients SOME_SHEET, mealName, IngredientList
    End If
Next

Pulling it out into its own procedure, we know that with 2 parameters and a good name, we've considerably improved PopulateShoppingList.


Whatch out here:

             If IsEmpty(IngredientList(0, 0)) Then GoTo Immediate
                For arrayIndex = LBound(IngredientList, 2) To UBound(IngredientList, 2)

Running it through Rubberduck / Smart Indenter would be like this:

               If IsEmpty(IngredientList(0, 0)) Then GoTo Immediate
               For arrayIndex = LBound(IngredientList, 2) To UBound(IngredientList, 2)

And consequently:

               Next arrayIndex
               ReDim Preserve IngredientList(1, UBound(IngredientList, 2) + 1)

This:

 ReDim Preserve IngredientList(1, UBound(IngredientList, 2) + 1)

In a loop, means you're copying the whole array over, for every single row! Since you know in advance how many rows you're going to need, it would be much more efficient to resize it once.

Each loop has a purpose - if nesting them makes things hard to follow, extract each loop into its own procedure, passing the needed parameters along: that will increase the abstraction level and contribute to reduce the indeed brutal nesting =)

\$\endgroup\$
2
  • \$\begingroup\$ You're saying since I know the rowIndex and mealLastRow I could resize the array at that point, knowing how many lines I'll use. But if there are any repeated ingredients, I'll get empties or duplicates in the array, I think. Or is that not what you mean? \$\endgroup\$ Feb 5 '18 at 3:23
  • 1
    \$\begingroup\$ You could use CountIf/CountIfs to evaluate the number of rows that will meet your criteria =) \$\endgroup\$ Feb 5 '18 at 3:26
4
\$\begingroup\$

To add to the list.

I noticed the following snippet:

    If IsEmpty(IngredientList(0, 0)) Then Exit Sub
    WriteShoppingList IngredientList
End Sub

This can be easily replaced by:

    If Not IsEmpty(IngredientList(0, 0)) Then WriteShoppingList(IngredientList)
End Sub

The less unconditional jumps (Breaks, Exits, Gotos) you use, the more robust your code can be. Sometimes it is as simple as looking at the code flow and determining if TRUE or FALSE is the best way to branch.

Similar refactoring can remove your other GOTOs (Immediate and NewIngredient). Might seem trivial, but it will give you more control over your code, and stronger thinking about the flow, conditions and reasons why you want to break out of loops. This will also make maintenance easier not just for yourself but for others.

You have:

    With wsPlan
        For arrayIndex = LBound(IngredientList, 2) To UBound(IngredientList, 2)
            [...]
            .Cells(rowIndex, columnIndex) = listItem
            rowIndex = rowIndex + 1
        Next
    End With

But only use "." once (.Cells(rowIndex, columnIndex) = listItem). In this instance, you can easily use WS.Cells(rowIndex, columnIndex) = listItem and remove one layer of nesting.

\$\endgroup\$
1
  • \$\begingroup\$ Good catch on the if and the with! I've been trying to figure out how to get rid of the other labels and I think I've made a little headway \$\endgroup\$ Feb 5 '18 at 5:41

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.