Alternative to excel VBA while loop

Question

I have a problem I have solved using several nested while loops. But unfortunately this means it takes many hours to run as doing it like this makes millions of iterations.

I would like to know if anyone can suggest a better method. I’ll describe the problem in a standard products and profit manner. I have 5 different product pages, each containing 100 products with their cost and the profit that will be made on them. I have to buy 2 products from one page and 3 from the others. I need to find the best combination to maximize profit based on having 10000 to spend (I can also only buy one of each product).

The code I have looks like the following, but as this takes so long and often crashes excel it is of no real use.

Do While productOneCount <= totalNumberOfProductOne
productOneCost = Worksheets("Product One").Range("C" & productOneCount)
productOneProfit = Worksheets("Product One").Range("E" & productOneCount)
secondProductOneCount = productOneCount + 1
Do While secondProductOneCount <= totalNumberOfProductOne
    secondProductOneCost = Worksheets("Product One").Range("C" & secondProductOneCount)
    secondProductOneProfit = Worksheets("Product One").Range("E" & secondProductOneCount)
    thirdProductOneCount = secondProductOneCount + 1
    Do While thirdProductOneCount <= totalNumberOfProductOne
        thirdProductOneCost = Range("C" & Worksheets("Product One").thirdProductOneCount)
        thirdProductOneProfit = Range("E" & Worksheets("Product One").thirdProductOneCount)
        productTwoCount = 1
        Do While productTwoCount <= totalNumberOfProductTwo
            productTwoCost = Worksheets("Product Two").Range("C" & productTwoCount)
            productTwoProfit = Worksheets("Product Two").Range("E" & productTwoCount)
            secondProductTwoCount = productTwoCount + 1
            Do While secondProductTwoCount <= totalNumberOfProductTwo
                secondProductTwoCost = Range("C" & secondProductTwoCount)
                secondProductTwoProfit = Range("E" & secondProductTwoCount)
                thirdProductTwoCount = secondProductTwoCount + 1

                '    this goes on for all 5 different products

                totalCost = productOneCost + secondProductOneCost + thirdProductOneCost + productTwoCost + secondProductTwoCost + restOfProductCosts
                totalProfit = productOneProfit + secondProductOneProfit + thirdProductOneProfit + productTwoProfit + secondProductTwoProfit + restOfProductProfit

                If totalCost <= 10000 Then
                    If totalProfit > bestProfit Then
                        Worksheets("Buy").Range("A1") = Worksheets("Product One").Range("B" & productOneCount)
                        Worksheets("Buy").Range("A2") = Worksheets("Product One").Range("B" & secondProductOneCount)
                        Worksheets("Buy").Range("A3") = Worksheets("Product One").Range("B" & thirdProductOneCount)
                        Worksheets("Buy").Range("A4") = Worksheets("Product Two").Range("B" & productTwoCount)
                        Worksheets("Buy").Range("A5") = Worksheets("Product Two").Range("B" & secondProductTwoCount)

                        Worksheets("Buy").Range("B1") = totalCost
                        Worksheets("Buy").Range("B2") = totalProfit
                        bestProfit = totalProfit
                    End If
                End If



                secondProductTwoCount = secondProductTwoCount + 1
            Loop
            productTwoCount = productTwoCount + 1
        Loop
        thirdProductOneCount = thirdProductOneCount + 1
    Loop
    secondProductOneCount = secondProductOneCount + 1
Loop
productOneCount = productOneCount + 1
Loop

Answer 1

While you try to improve the algorithm like A.S.H. mentioned, the easiest change you can make is to minimize the interactions with ranges - move all data to memory as Charles suggested

This is to illustrate how you can convert; it should increase efficiency exponentially as you can see in this answer (500 K cells processed in 2.023 sec as Arrays vs 43.578 sec as Cells)

.

Option Explicit

Public Sub x()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
    Dim arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant, arr5 As Variant

    Set ws1 = Worksheets("Product One")
    Set ws2 = Worksheets("Product Two")
    '...
    arr1 = ws1.Range("C" & fRow & ":C" & lRow & ",E" & fRow & ":E" & lRow)      'move from range to array
    arr2 = ws2.Range("C" & fRow & ":C" & lRow & ",E" & fRow & ":E" & lRow)
    '...

    Do While productOneCount <= totalNumberOfProductOne
        productOneCost = arr1(productOneCount, 1)
        productOneProfit = arr1(productOneCount, 2)
        secondProductOneCount = productOneCount + 1
        Do While secondProductOneCount <= totalNumberOfProductOne
            secondProductOneCost = arr1(secondProductOneCount, 1)
            secondProductOneProfit = arr1(secondProductOneCount, 2)
            thirdProductOneCount = secondProductOneCount + 1
            Do While thirdProductOneCount <= totalNumberOfProductOne
                thirdProductOneCost = arr1(thirdProductOneCount, 1)
                thirdProductOneProfit = arr1(thirdProductOneCount, 2)
                productTwoCount = 1
                Do While productTwoCount <= totalNumberOfProductTwo
                    productTwoCost = arr2(productTwoCount, 1)
                    productTwoProfit = arr2(productTwoCount, 2)
                    secondProductTwoCount = productTwoCount + 1
                    '...
                    Do While secondProductTwoCount <= totalNumberOfProductTwo
                        '    this goes on for all 5 different products
                        If totalCost <= 10000 Then
                            If totalProfit > bestProfit Then
                                arr(1, 1) = arr(productOneCount, 2)
                                arr(2, 1) = arr(secondProductOneCount, 2)
                                arr(3, 1) = arr(thirdProductOneCount, 2)
                                arr(4, 1) = arr(productTwoCount, 2)
                                arr(5, 1) = arr(thirdProductOneCount, 2)
                                arr(1, 2) = totalCost
                                arr(2, 2) = totalProfit
                                bestProfit = totalProfit
                            End If
                        End If
                        secondProductTwoCount = secondProductTwoCount + 1
                    Loop
                    productTwoCount = productTwoCount + 1
                Loop
                thirdProductOneCount = thirdProductOneCount + 1
            Loop
            secondProductOneCount = secondProductOneCount + 1
        Loop
        productOneCount = productOneCount + 1
    Loop
End Sub

---

Obviously this is not set up correctly and you'll have to adjust it accordingly, but at the end you'll just have to place the arrays back on the sheets in one, very efficient, exchange similar to

ws2.Range("C" & fRow & ":C" & lRow & ",E" & fRow & ":E" & lRow) = arr2