Calculate combinations that leads to max intake in VBA using one column

[Will_vanthek]

Dear people,

I have a question, hope you can help me. In enclosed image I have a column with number in them, lets say 10 items.
Further I have a cell with 1 number, this is the max to be loaded: 10.000

Now, I need to find the combinations that will bring me <=10.000.
This means it can be cargo as: 1+2+5+6 or 1 + 4 +5 Etc.

All outcome, all combinations should lead towards the 10000, on top the combinations that are closest to the 10.000.
I see many tutorials doing this with two list etc, but I want to do this in one column, if this possible.

I prefer VBA code, but if otherwise possible than I hope you can help me.

greets will

 

[Eric W]

Welcome to MrExcel!

Try:

Sub Combos()
Dim vals As Variant, opc As Range, dic As Object, mmax As Double, op() As Variant
Dim i As Long, s As String, c As String, t As Double, x As Variant

    vals = Range("B3:B12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value
    
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 2 ^ UBound(vals)
        s = WorksheetFunction.Base(i, 2, UBound(vals))
        c = ""
        t = 0
        For j = 1 To UBound(vals)
            If Mid(s, UBound(vals) - j + 1, 1) = "1" Then
                c = c & j & ","
                t = t + vals(j, 1)
            End If
        Next j
        If t <= mmax Then
            c = Left(c, Len(c) - 1)
            dic(c) = t
        End If
    Next i
    
    ReDim op(0 To dic.Count, 1 To 3)
    i = 1
    For Each x In dic
        op(i, 1) = i
        op(i, 2) = x
        op(i, 3) = dic(x)
        i = i + 1
    Next x
    
    op(0, 1) = "Result:"
    op(0, 2) = "Include:"
    op(0, 3) = "Total"
    
    opc.Resize(dic.Count + 1, 3) = op
    opc.Offset(1, 1).Resize(dic.Count, 2).Sort Key1:=opc.Offset(1, 2), order1:=xlDescending
    
End Sub

Look for these 3 lines at the top:

    vals = Range("B3:B12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value

and set the ranges to the input amounts, the upper left corner where you want the output, and the max value.

 

[Will_vanthek]

Welcome to MrExcel!

Try:

Sub Combos()
Dim vals As Variant, opc As Range, dic As Object, mmax As Double, op() As Variant
Dim i As Long, s As String, c As String, t As Double, x As Variant

    vals = Range("B3:B12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 2 ^ UBound(vals)
        s = WorksheetFunction.Base(i, 2, UBound(vals))
        c = ""
        t = 0
        For j = 1 To UBound(vals)
            If Mid(s, UBound(vals) - j + 1, 1) = "1" Then
                c = c & j & ","
                t = t + vals(j, 1)
            End If
        Next j
        If t <= mmax Then
            c = Left(c, Len(c) - 1)
            dic(c) = t
        End If
    Next i
   
    ReDim op(0 To dic.Count, 1 To 3)
    i = 1
    For Each x In dic
        op(i, 1) = i
        op(i, 2) = x
        op(i, 3) = dic(x)
        i = i + 1
    Next x
   
    op(0, 1) = "Result:"
    op(0, 2) = "Include:"
    op(0, 3) = "Total"
   
    opc.Resize(dic.Count + 1, 3) = op
    opc.Offset(1, 1).Resize(dic.Count, 2).Sort Key1:=opc.Offset(1, 2), order1:=xlDescending
   
End Sub

Look for these 3 lines at the top:

    vals = Range("B3:B12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value

and set the ranges to the input amounts, the upper left corner where you want the output, and the max value.

Thanks Eric. i will try it and revert asap. Thanks wizard

 

[Will_vanthek]

Welcome to MrExcel!

Try:

Sub Combos()
Dim vals As Variant, opc As Range, dic As Object, mmax As Double, op() As Variant
Dim i As Long, s As String, c As String, t As Double, x As Variant

    vals = Range("B3:B12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 2 ^ UBound(vals)
        s = WorksheetFunction.Base(i, 2, UBound(vals))
        c = ""
        t = 0
        For j = 1 To UBound(vals)
            If Mid(s, UBound(vals) - j + 1, 1) = "1" Then
                c = c & j & ","
                t = t + vals(j, 1)
            End If
        Next j
        If t <= mmax Then
            c = Left(c, Len(c) - 1)
            dic(c) = t
        End If
    Next i
   
    ReDim op(0 To dic.Count, 1 To 3)
    i = 1
    For Each x In dic
        op(i, 1) = i
        op(i, 2) = x
        op(i, 3) = dic(x)
        i = i + 1
    Next x
   
    op(0, 1) = "Result:"
    op(0, 2) = "Include:"
    op(0, 3) = "Total"
   
    opc.Resize(dic.Count + 1, 3) = op
    opc.Offset(1, 1).Resize(dic.Count, 2).Sort Key1:=opc.Offset(1, 2), order1:=xlDescending
   
End Sub

Look for these 3 lines at the top:

    vals = Range("B3:B12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value

and set the ranges to the input amounts, the upper left corner where you want the output, and the max value.

Dear Eric, it works brilliantly.

Is it possible to get the outcome 2,5,7,8 in seperate cells next to eachother. So that each number has its own cell?

 

[Will_vanthek]

The values in cargo B3:B12 are all variables, nothing firm booked yet, all these cargoes are pending (P). But what if one item is booked (B). Let's say number 4 = (2500).
Then I only need to see the combinations which have that booked cargo in it. If two items were booked, I only would like to see the combinations with the two booked included.
Is this possible?

 

[Will_vanthek]

The values in cargo B3:B12 are all variables, nothing firm booked yet, all these cargoes are pending (P). But what if one item is booked (B). Let's say number 4 = (2500).
Then I only need to see the combinations which have that booked cargo in it. If two items were booked, I only would like to see the combinations with the two booked included.
Is this possible?

 

[Eric W]

Try this:

Sub Combos()
Dim vals As Variant, opc As Range, dic As Object, mmax As Double, op() As Variant
Dim i As Long, s As String, c As String, t As Double, x As Variant

    vals = Range("B3:C12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value
    
    Application.ScreenUpdating = False
    opc.Resize(2 ^ UBound(vals) + 5, UBound(vals) + 5).ClearContents
    
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 2 ^ UBound(vals)
        s = WorksheetFunction.Base(i, 2, UBound(vals))
        c = ""
        t = 0
        For j = 1 To UBound(vals)
            If Mid(s, UBound(vals) - j + 1, 1) = "1" Then
                c = c & j & ","
                t = t + vals(j, 1)
            Else
                If vals(j, 2) = "B" Then GoTo NextI:
            End If
        Next j
        If t <= mmax Then
            c = Left(c, Len(c) - 1)
            dic(c) = t
        End If
NextI:
    Next i
    
    ReDim op(0 To dic.Count, 1 To 3)
    i = 1
    For Each x In dic
        op(i, 1) = i
        op(i, 2) = dic(x)
        op(i, 3) = x
        i = i + 1
    Next x
    
    op(0, 1) = "Result:"
    op(0, 2) = "Total"
    op(0, 3) = "Results"
    
    opc.Resize(dic.Count + 1, 3) = op
    opc.Offset(1, 1).Resize(dic.Count, 2).Sort Key1:=opc.Offset(1, 1), order1:=xlDescending
    opc.Offset(1, 2).Resize(dic.Count).TextToColumns DataType:=xlDelimited, comma:=True
        
    Application.ScreenUpdating = True
    
End Sub

Note that the input range is now 2 columns to include the B/P.

 

[Will_vanthek]

Try this:

Sub Combos()
Dim vals As Variant, opc As Range, dic As Object, mmax As Double, op() As Variant
Dim i As Long, s As String, c As String, t As Double, x As Variant

    vals = Range("B3:C12").Value
    Set opc = Range("E4")
    mmax = Range("F1").Value
   
    Application.ScreenUpdating = False
    opc.Resize(2 ^ UBound(vals) + 5, UBound(vals) + 5).ClearContents
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 2 ^ UBound(vals)
        s = WorksheetFunction.Base(i, 2, UBound(vals))
        c = ""
        t = 0
        For j = 1 To UBound(vals)
            If Mid(s, UBound(vals) - j + 1, 1) = "1" Then
                c = c & j & ","
                t = t + vals(j, 1)
            Else
                If vals(j, 2) = "B" Then GoTo NextI:
            End If
        Next j
        If t <= mmax Then
            c = Left(c, Len(c) - 1)
            dic(c) = t
        End If
NextI:
    Next i
   
    ReDim op(0 To dic.Count, 1 To 3)
    i = 1
    For Each x In dic
        op(i, 1) = i
        op(i, 2) = dic(x)
        op(i, 3) = x
        i = i + 1
    Next x
   
    op(0, 1) = "Result:"
    op(0, 2) = "Total"
    op(0, 3) = "Results"
   
    opc.Resize(dic.Count + 1, 3) = op
    opc.Offset(1, 1).Resize(dic.Count, 2).Sort Key1:=opc.Offset(1, 1), order1:=xlDescending
    opc.Offset(1, 2).Resize(dic.Count).TextToColumns DataType:=xlDelimited, comma:=True
       
    Application.ScreenUpdating = True
   
End Sub

Note that the input range is now 2 columns to include the B/P.

Eric, again it works marvelous. I know I ask a lot but am i allowed to extend my question?

 

[Will_vanthek]

Each cargo comes along with a distance where the caro is loaded and discharged. In cargo number 1, this is 423 Nm. The total expens for this voyage = 676.8 and the revenu = 761.4. The profit is revenue - Costs. No when finding the combinations it would be superb if we could add up the distance, costs and revenu (each colum seperately) so we can see what each option will bring.
Now, a voyage can be seleced based on Mmax intake, distance and profit. By using a 1 or a 0 i could select what criteria is important to my at that time. So if I make a 1 on Mmax,the combinations that show me the mmax intake is shown, if I select diatnce as a 1, then the shortest distance on top will be shown, same goes for profit. Is this doable?

Is there someway i could contact you outside this forum. I want to give you something for the effort you make. Can I contact you in some way?

 

[Will_vanthek]

In the previous solution, before my last question, i found a thing about the combinations.

In the left column i have three booked cargoes, number 2,4,10.. The result would be that only result line 3 + 4 should be visible as these are the only lines that have a all booked cargo on board.
All the oranged coloured lines do not have all the booked cargo on board.