SOLVED

Find Best Combination of Values in Different Columns Closest to Target Value

Copper Contributor

Hello,

 

I need to find the best combination of values from multiple columns that are closest (not over) to a given target value. Only 1 value from each column can be used.

What would be the best way to achieve this?

excel best combination 1.PNG

 

Thank you.

5 Replies
best response confirmed by Chris550 (Copper Contributor)
Solution

@Chris550 

One option is a recursive VBA function. It works very well with your example, but it would bog down if the range to process is large.

Code to be copied into a module in the Visual Basic Editor:

Dim v() As Variant
Dim s() As Double
Dim m() As Long
Dim mr() As Long
Dim n1, n2 As Long
Dim t As Double
Dim d As Double
Dim c As Long

Function FindSolution(rng As Range, tgt As Double)
    v = rng.Value
    n1 = UBound(v, 1)
    n2 = UBound(v, 2)
    ReDim r(1 To n2)
    ReDim w(1 To n2)
    ReDim s(0 To n2)
    ReDim m(1 To n2)
    ReDim mr(1 To n2)
    t = tgt
    d = 10000000
    Call ProcessColumn(1)
    For c = 1 To n2
        w(c) = v(m(c), c)
    Next c
    FindSolution = w
End Function

Sub ProcessColumn(c As Long)
    Dim r As Long
    Dim i As Long
    For r = 1 To n1
        mr(c) = r
        s(c) = s(c - 1) + v(r, c)
        If s(c) <= t Then
            If c = n2 Then
                If t - s(c) < d Then
                    d = t - s(c)
                    For i = 1 To n2
                        m(i) = mr(i)
                    Next i
                End If
            Else
                Call ProcessColumn(c + 1)
            End If
        End If
    Next r
End Sub

 Use like this in a cell formula:

 

=FindSolution(A2:D11,G2)

 

The workbook must be saved as a macro-enabled workbook (*.xlsm).

See the attached sample workbook.

https://answers.microsoft.com/en-us/msoffice/forum/all/in-excel-how-can-i-add-every-value-in-one-col...

Cartesian product and filter?

select * from Cartesian_sum_each_combination;
select a.F_A,b.F_B,c.F_C,d.F_D,max(a.F_A+b.F_B+c.F_C+d.F_D) from Cartesian_sum_each_combination a,Cartesian_sum_each_combination b,Cartesian_sum_each_combination c,Cartesian_sum_each_combination d where a.F_A+b.F_B+c.F_C+d.F_D<=15

F_A F_B F_C F_D
1 4 7 1
2 5 9 2
3 6 2
F_A F_B F_C F_D max(a.F_A+b.F_B+c.F_C+d.F_D)
1 4 9 1 15

@HansVogelaar 

Thanks for the response.

This seems like a great solution.

Would it be possible to have excel output all best combinations?

For example, the solution in your worksheet is:

1, 5, .9, 18

However the following would also be candidates for best combination:

(2, 4, .9, 18), (3, 3, .9, 18), (5, 8, .9, 11) plus many more combinations.

@Chris550 

This example finds all possible combinations of numbers 1 to 9 that sum to exactly 25.  The more unique numbers you have, the more difficult (and eventually, impossible) this becomes with a formula.

 

 

 

=LET(
    combinations, SUM(COMBIN(9, SEQUENCE(9))),
    BinMatrix, DEC2BIN(SEQUENCE(combinations), 9),
    NumMatrix, MAKEARRAY(
        combinations,
        9,
        LAMBDA(r, c, c * MID(INDEX(BinMatrix, r), c, 1))
    ),
    crit, BYROW(NumMatrix, LAMBDA(row, SUM(row))),
    FILTER(NumMatrix, crit = 25)
)

 

The attached workbook steps through it by each piece.

 

 

 

@Chris550 

See the attached version.

1 best response

Accepted Solutions
best response confirmed by Chris550 (Copper Contributor)
Solution

@Chris550 

One option is a recursive VBA function. It works very well with your example, but it would bog down if the range to process is large.

Code to be copied into a module in the Visual Basic Editor:

Dim v() As Variant
Dim s() As Double
Dim m() As Long
Dim mr() As Long
Dim n1, n2 As Long
Dim t As Double
Dim d As Double
Dim c As Long

Function FindSolution(rng As Range, tgt As Double)
    v = rng.Value
    n1 = UBound(v, 1)
    n2 = UBound(v, 2)
    ReDim r(1 To n2)
    ReDim w(1 To n2)
    ReDim s(0 To n2)
    ReDim m(1 To n2)
    ReDim mr(1 To n2)
    t = tgt
    d = 10000000
    Call ProcessColumn(1)
    For c = 1 To n2
        w(c) = v(m(c), c)
    Next c
    FindSolution = w
End Function

Sub ProcessColumn(c As Long)
    Dim r As Long
    Dim i As Long
    For r = 1 To n1
        mr(c) = r
        s(c) = s(c - 1) + v(r, c)
        If s(c) <= t Then
            If c = n2 Then
                If t - s(c) < d Then
                    d = t - s(c)
                    For i = 1 To n2
                        m(i) = mr(i)
                    Next i
                End If
            Else
                Call ProcessColumn(c + 1)
            End If
        End If
    Next r
End Sub

 Use like this in a cell formula:

 

=FindSolution(A2:D11,G2)

 

The workbook must be saved as a macro-enabled workbook (*.xlsm).

See the attached sample workbook.

View solution in original post