VBA – Avoid nested loops with recursion (Part 2)

About two years after the “Nested loops with recursion” today I was looking for a way to avoid nested loops with recursion in google and found my article 🙂 . Lots has changed in my coding style since then as far as I do not use “Call”, “Integer”, variables with names like “c” or “n”, I do not put “_” in the names of the Subs/Functions. Still, using the article from 2015 I have managed to achieve what I wanted.

So, what did I want to do? I wanted to simulate a brute force solution of this NP-complete problem:

Picture: https://xkcd.com/287/

At first I have thought about a solution with 6 nested for loops and I have managed to achieve it in a way pretty easily:

Option Explicit

Sub TestMe()

    Dim myArr           As Variant
    Dim myLoop          As Variant
    Dim targetValue     As Long
    Dim currentSum      As Long

    myArr = Array(215, 275, 335, 355, 420, 580)
    targetValue = 1505

    Dim cnt0&, cnt1&, cnt2&, cnt3&, cnt4&, cnt5&, cnt6&
    Dim cnt As Long


    For cnt0 = 0 To 5
        For cnt1 = 0 To 5
            For cnt2 = 0 To 5
                For cnt3 = 0 To 5
                    For cnt4 = 0 To 5
                        For cnt5 = 0 To 5
                            currentSum = 0

                            Dim printableArray As Variant
                            printableArray = Array(cnt0, cnt1, cnt2, cnt3, cnt4, cnt5)

                            For cnt = LBound(myArr) To UBound(myArr)
                                IncrementSum printableArray(cnt), myArr(cnt), currentSum
                            Next cnt

                            If currentSum = targetValue Then
                                PrintValuesOfArray printableArray, myArr
                            End If
    Next: Next: Next: Next: Next: Next

End Sub

Public Sub PrintValuesOfArray(myArr As Variant, initialArr As Variant)

    Dim cnt             As Long
    Dim printVal        As String

    For cnt = LBound(myArr) To UBound(myArr)
        If myArr(cnt) Then
            printVal = printVal & myArr(cnt) & " * " & initialArr(cnt) & vbCrLf
        End If
    Next cnt

    Debug.Print printVal

End Sub

Public Sub IncrementSum(ByVal multiplicator As Long, _
    ByVal arrVal As Long, ByRef currentSum As Long)

    currentSum = currentSum + arrVal * multiplicator

End Sub

Then, I have remembered that I actually think of myself as a high level VBA developer and 6 nested loops is a bit “ugly”. Thus, I have googled “nested loops recursion vba” and the vitoshacademy.com was one of the top results 🙂 Ironic, I thought! 🙂 Anyhow, although the code I have written some years ago was a bit “bad”, I have managed to use it and to build this:

Option Explicit

Sub Main()

    Dim posArr                  As Variant
    Dim iniArr                  As Variant
    Dim tryArr                  As Variant
    Dim cnt                     As Long
    Dim targetVal               As Long: targetVal = 1505

    iniArr = Array(215, 275, 335, 355, 420, 580)
    ReDim posArr(UBound(iniArr))
    ReDim tryArr(UBound(iniArr))

    For cnt = LBound(posArr) To UBound(posArr)
        posArr(cnt) = cnt
    Next cnt
    EmbeddedLoops 0, posArr, tryArr, iniArr, targetVal

End Sub

Function EmbeddedLoops(index As Long, posArr As Variant, tryArr As Variant, _
                                      iniArr As Variant, targetVal As Long)

    Dim myUnit              As Variant
    Dim cnt                 As Long

    If index >= UBound(posArr) + 1 Then
        If CheckSum(tryArr, iniArr, targetVal) Then
            For cnt = LBound(tryArr) To UBound(tryArr)
                If tryArr(cnt) Then Debug.Print tryArr(cnt) & " x " & iniArr(cnt)
            Next cnt
        End If
    Else
        For Each myUnit In posArr
            tryArr(index) = myUnit
            EmbeddedLoops index + 1, posArr, tryArr, iniArr, targetVal
        Next myUnit
    End If

End Function

Public Function CheckSum(posArr, iniArr, targetVal) As Boolean

    Dim cnt         As Long
    Dim compareVal  As Long

    For cnt = LBound(posArr) To UBound(posArr)
        compareVal = posArr(cnt) * iniArr(cnt) + compareVal
    Next cnt
    CheckSum = CBool(compareVal = targetVal)

End Function

If you are wondering for the choice, this is what the waiter should bring:

1 * Mixed Fruit (2.15)
2 * Hot Wings (3.55)
1 * Sampler Plate (5.80)

The solution is not quite full, as far as I have assumed that the positions cannot be more than the squared number of the listed items. Thus, in our case a solution with more than 6×6 units is not considered. Thus, in case that there was a dessert that costs 5 cents, the obvious solution of 301 such desserts will not appear.

Cheers!

Edit:

Or you can order 7 * Mixed Fruit, if you use the good old Sover. Credit to IvenBach for the solution:

Data>Analysis>Solver>Model=GRG Nonlinear