Optimizing large data set using VBA (Solver not working)

Question

I have a large set of data on which I need to obtain a set of values that reach to a desired number. To be more precise, I have supermarket tickets each of them with one ID number and the amount that was charged to the customer.

I have to pick up tickets that add to a specific number (let's say 1,000,000 USD). I tried using solver where in one column you use a binary 1/0 variable and then just sumif to get the ones that solver selects that add up to the target value of 1M. However, this works when the sample is small. The file i just got has over 280,000 tickets, so there is no way solver can handle that number of binary variables.

How can I get in one column the number of tickets that add up to 1,000,000? I tried using a "while" loop but my computer crashes after 5 min or so. Any ideas?

Thanks!

A loop or solver won't be able to solve such a complex problem. See [Cutting Stock Problem](https://en.wikipedia.org/wiki/Cutting_stock_problem) to get a feel of how complex this can get with just 13 items. Please provide more information. For example, are you looking for any combination, all combinations, the best combination etc. Based on what you want out of this, you can then plan a strategy. Also post the code that you've already tried as that is best practice for this site — Cristian Buse, Jul 01 '22 at 19:29
Hi, thanks Cristian for your reply. I have tried this so far: — lbochitt, Jul 01 '22 at 19:39
Sub Example() Const STARTING_ROW As Long = 2 Const VALUE_COLUMN As Long = 31 Dim DataSheet As Worksheet Set DataSheet = ActiveSheet Dim CurrentRow As Range Set CurrentRow = DataSheet.Rows(STARTING_ROW) Dim Tickets As New Collection, Total As Double While Total < 1000000 Tickets.Add CurrentRow With CurrentRow.Columns(VALUE_COLUMN) If IsNumeric(.Value) Then Total = Total + .Value End With If CurrentRow.Row = CurrentRow.Parent.Rows.Count Then Exit Sub Else Set CurrentRow = CurrentRow.Offset(1) End If Wend End Sub` — lbochitt, Jul 01 '22 at 19:53
You should *edit your question* if you want to add more info or code - code in comments is unreadable. — Tim Williams, Jul 01 '22 at 21:42
This post directly addresses your problem and has a lot of answers: https://stackoverflow.com/questions/4632322/finding-all-possible-combinations-of-numbers-to-reach-a-given-sum And related wikipedia entry: https://en.wikipedia.org/wiki/Subset_sum_problem — Tim Williams, Jul 01 '22 at 21:44

score 0 · Answer 1 · answered Jul 05 '22 at 19:57

Is this what you want? Enter the logic in A1:A11.

=RANDBETWEEN(1,50)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A1)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A2)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A3)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A4)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A5)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A6)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A7)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A8)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A9)),0)
=SUM(A1:A10)

Result

Or, maybe this. Enter this in A1:A41

8 6 3 2 6 10 9 4 12 8 6 1 8 10 8 14 10 9 12 12 14 6 4 3 4 4 4 0 6 10 4 9 6 3 11 12 10 7 12 8 8

Put 92 in cell B1, and run this VBA.

Sub FindSeries()

Dim StartRng As Range
Dim EndRng As Range
Dim Answer As Long
Dim TestTotal As Long

Answer = Range("B1") '<<< CHANGE

Set StartRng = Range("A1")
Set EndRng = StartRng
Do Until False
    TestTotal = Application.Sum(Range(StartRng, EndRng))
    If TestTotal = Answer Then
        Range(StartRng, EndRng).Select
        Exit Do
    ElseIf TestTotal > Answer Then
        Set StartRng = StartRng(2, 1)
        Set EndRng = StartRng
    Else
        Set EndRng = EndRng(2, 1)
        If EndRng.Value = vbNullString Then
            MsgBox "No series found"
            Exit Do
        End If
    End If
Loop
End Sub

Optimizing large data set using VBA (Solver not working)

1 Answers1