Find combination

[Kendok]

Hi there
I got this data:

The client only sends me a total of 1220 in units and 6064.40 in price, so I have to find out which rows are part of those totals.
I have tried kutools with make a number, but it only lets you choose a search, and of course there are more than 16000 options to combine the products and that add up to 1220 but of course, if I were also able to extract only those that add up to 6064.4 in this price number would be reduced by far to 1 or two options at most.
Solver is also not an option because it doesn't allow me to add more than one criteria in sum.
The truth is that I don't know how I should do it anymore, my brain has boiled.
I don't know if I explained myself...

PS when I try to use kutools to find the combinations by price it goes crazy and quits so that's not an option either

Any ideas?

 

[johnnyL]

I guess @Kendok is not that interested. Oh well.

 

[Legacy 143009]

I've just realized that my previous code can not allocate (1, (2 ^ lRow) - 2) size array when there are 60 rows due to VBA limitations
Here is another code will check up to 5 combinations. Check column K for results.

Sub combinations()
  Dim items() As Variant
  Dim combLen As Long
  Dim lRow As Long, targetVal As Double, result As Double
  lRow = Cells(Rows.count, 1).End(xlUp).Row
  targetVal = 6064.4
 
  For c = 1 To 5
    combLen = c
    ReDim items(1 To lRow - 1)
 
    For i = 2 To lRow
      items(i - 1) = Cells(i, 7).Value
    Next
 
    items = binomial(items, combLen)

    For i = 1 To nChooseK(lRow - 1, combLen)
      result = 0
      For j = 1 To combLen
        result = result + CDbl(items(i, j))
        If result = targetVal Then
          With Application
          For k = 1 To combLen
            For n = 11 To 16
              Cells(k, n).Value = Cells(Application.Match(items(i, k), Range("G1:G" & lRow), 0), n - 10).Value
            Next
            Cells(k, 17).Value = items(i, k)
          Next
          Exit Sub
          End With
        End If
      Next
    Next
  Next
  MsgBox "No solution!"
End Sub
Function binomial(ByRef v() As Variant, r As Long) As Variant()
  Dim i As Long, k As Long, z() As Variant, comboMatrix() As Variant
  Dim numRows As Long, numIter As Long, n As Long, count As Long
   
  count = 1
  n = UBound(v)
  numRows = nChooseK(n, r)
 
  ReDim z(1 To r)
  ReDim comboMatrix(1 To numRows, 1 To r)
  For i = 1 To r
    z(i) = i
  Next
  Do While (count <= numRows)
    numIter = n - z(r) + 1
    For i = 1 To numIter
      For k = 1 To r
        comboMatrix(count, k) = v(z(k))
      Next
      count = count + 1
     z(r) = z(r) + 1
    Next
    For i = r - 1 To 1 Step -1
      If Not (z(i) = (n - r + i)) Then
        z(i) = z(i) + 1
        For k = (i + 1) To r
          z(k) = z(k - 1) + 1
        Next
        Exit For
      End If
    Next
  Loop
  binomial = comboMatrix
End Function
Function nChooseK(n As Long, k As Long) As Long
  Dim temp As Double, i As Long
  temp = 1
  For i = 1 To k
    temp = temp * (n - k + i) / i
  Next
  nChooseK = CLng(temp)
End Function

By the way, there are no possible solutions for 6064.4 for the given list.

 

[Kendok]

Something like this

In fact there are like 4 or 5 invoices. The idea would be to associate each invoice number with the list of products. Knowing that all the products have been served, but we do not know in which invoice they have been included...

 

[Kendok]

I've just realized that my previous code can not allocate (1, (2 ^ lRow) - 2) size array when there are 60 rows due to VBA limitations
Here is another code will check up to 5 combinations. Check column K for results.

Sub combinations()
  Dim items() As Variant
  Dim combLen As Long
  Dim lRow As Long, targetVal As Double, result As Double
  lRow = Cells(Rows.count, 1).End(xlUp).Row
  targetVal = 6064.4
 
  For c = 1 To 5
    combLen = c
    ReDim items(1 To lRow - 1)
 
    For i = 2 To lRow
      items(i - 1) = Cells(i, 7).Value
    Next
 
    items = binomial(items, combLen)

    For i = 1 To nChooseK(lRow - 1, combLen)
      result = 0
      For j = 1 To combLen
        result = result + CDbl(items(i, j))
        If result = targetVal Then
          With Application
          For k = 1 To combLen
            For n = 11 To 16
              Cells(k, n).Value = Cells(Application.Match(items(i, k), Range("G1:G" & lRow), 0), n - 10).Value
            Next
            Cells(k, 17).Value = items(i, k)
          Next
          Exit Sub
          End With
        End If
      Next
    Next
  Next
  MsgBox "No solution!"
End Sub
Function binomial(ByRef v() As Variant, r As Long) As Variant()
  Dim i As Long, k As Long, z() As Variant, comboMatrix() As Variant
  Dim numRows As Long, numIter As Long, n As Long, count As Long
  
  count = 1
  n = UBound(v)
  numRows = nChooseK(n, r)
 
  ReDim z(1 To r)
  ReDim comboMatrix(1 To numRows, 1 To r)
  For i = 1 To r
    z(i) = i
  Next
  Do While (count <= numRows)
    numIter = n - z(r) + 1
    For i = 1 To numIter
      For k = 1 To r
        comboMatrix(count, k) = v(z(k))
      Next
      count = count + 1
     z(r) = z(r) + 1
    Next
    For i = r - 1 To 1 Step -1
      If Not (z(i) = (n - r + i)) Then
        z(i) = z(i) + 1
        For k = (i + 1) To r
          z(k) = z(k - 1) + 1
        Next
        Exit For
      End If
    Next
  Loop
  binomial = comboMatrix
End Function
Function nChooseK(n As Long, k As Long) As Long
  Dim temp As Double, i As Long
  temp = 1
  For i = 1 To k
    temp = temp * (n - k + i) / i
  Next
  nChooseK = CLng(temp)
End Function

By the way, there are no possible solutions for 6064.4 for the given list.

it returns an error

 

[Legacy 143009]

View attachment 84740

it returns an error

It was my first code. try the this code:

I've just realized that my previous code can not allocate (1, (2 ^ lRow) - 2) size array when there are 60 rows due to VBA limitations
Here is another code will check up to 5 combinations. Check column K for results.

Sub combinations()
  Dim items() As Variant
  Dim combLen As Long
  Dim lRow As Long, targetVal As Double, result As Double
  lRow = Cells(Rows.count, 1).End(xlUp).Row
  targetVal = 6064.4
 
  For c = 1 To 5
    combLen = c
    ReDim items(1 To lRow - 1)
 
    For i = 2 To lRow
      items(i - 1) = Cells(i, 7).Value
    Next
 
    items = binomial(items, combLen)

    For i = 1 To nChooseK(lRow - 1, combLen)
      result = 0
      For j = 1 To combLen
        result = result + CDbl(items(i, j))
        If result = targetVal Then
          With Application
          For k = 1 To combLen
            For n = 11 To 16
              Cells(k, n).Value = Cells(Application.Match(items(i, k), Range("G1:G" & lRow), 0), n - 10).Value
            Next
            Cells(k, 17).Value = items(i, k)
          Next
          Exit Sub
          End With
        End If
      Next
    Next
  Next
  MsgBox "No solution!"
End Sub
Function binomial(ByRef v() As Variant, r As Long) As Variant()
  Dim i As Long, k As Long, z() As Variant, comboMatrix() As Variant
  Dim numRows As Long, numIter As Long, n As Long, count As Long
  
  count = 1
  n = UBound(v)
  numRows = nChooseK(n, r)
 
  ReDim z(1 To r)
  ReDim comboMatrix(1 To numRows, 1 To r)
  For i = 1 To r
    z(i) = i
  Next
  Do While (count <= numRows)
    numIter = n - z(r) + 1
    For i = 1 To numIter
      For k = 1 To r
        comboMatrix(count, k) = v(z(k))
      Next
      count = count + 1
     z(r) = z(r) + 1
    Next
    For i = r - 1 To 1 Step -1
      If Not (z(i) = (n - r + i)) Then
        z(i) = z(i) + 1
        For k = (i + 1) To r
          z(k) = z(k - 1) + 1
        Next
        Exit For
      End If
    Next
  Loop
  binomial = comboMatrix
End Function
Function nChooseK(n As Long, k As Long) As Long
  Dim temp As Double, i As Long
  temp = 1
  For i = 1 To k
    temp = temp * (n - k + i) / i
  Next
  nChooseK = CLng(temp)
End Function

By the way, there are no possible solutions for 6064.4 for the given list.

 

[Kendok]

It was my first code. try the this code:

ouch...

the question is that there MUST be a solution, because the list is the breakdown of the shipment for its importation, so it cannot be that there is no solution... :-s
Thanks for the help!

 

[Legacy 143009]

I've already wrote in the post. This code checks from 1 to 5 combinations of every record. There is no possible solution for 6064.4 in this dataset. At least up to 5 records...

Ok try to set target value to 1026.8 and rerun. You'll understand what I mean.

targetVal = 1026.8

 

[Kendok]

I've already wrote in the post. This code checks from 1 to 5 combinations of every record. There is no possible solution for 6064.4 in this dataset. At least up to 5 records...

Ok try to set target value to 1026.8 and rerun. You'll understand what I mean.

targetVal = 1026.8

oki oki, thnx!

 

[johnnyL]

Solver Solution:
16,21,41,43,44,45,46

Combinations of Column Values that Add up to a Value V1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Descrip	T1	Country	Find	T2	Unity	Price				Target 1	Target 2	Difference	Price Difference		Solution
2	1		NL			12	53.04	1	12	53.04	1220	6064.4	3309	7379.78		16,21,41,43,44,45,46
3	2		NL			12	56.88	1	12	56.88
4	3		NL			122	506	1	122	506
5	4		NL			100	285	1	100	285
6	5		NL			90	502.38	1	90	502.38
7	6		NL			60	360	1	60	360
8	7		NL			50	54.5	1	50	54.5
9	8		NL			24	61.8	1	24	61.8
10	9		NL			30	121.05	1	30	121.05
11	10		NL			30	56.4	1	30	56.4
12	11		NL			36	69.84	1	36	69.84
13	12		NL			50	110	1	50	110
14	13		NL			40	46	1	40	46
15	14		NL			65	416.5	1	65	416.5
16	15		NL			48	408	1	48	408
17	16		NL			18	44.1	1	18	44.1
18	17		NL			40	90.8	1	40	90.8
19	18		NL			70	402.5	1	70	402.5
20	19		NL			117	412.8	1	117	412.8
21	20		NL			32	440	1	32	440
22	21		NL			100	135	1	100	135
23	22		NL			144	211.68	1	144	211.68
24	23		NL			50	63.5	1	50	63.5
25	24		NL			96	168.96	1	96	168.96
26	25		NL			42	60.48	1	42	60.48
27	26		NL			30	103.2	1	30	103.2
28	27		NL			18	72.72	1	18	72.72
29	28		NL			18	72.72	1	18	72.72
30	29		NL			12	48.48	1	12	48.48
31	30		NL			180	108	1	180	108
32	31		NL			24	50.88	1	24	50.88
33	32		NL			105	51.45	1	105	51.45
34	33		NL			96	57.6	1	96	57.6
35	34		NL			400	500	1	400	500
36	35		NL			30	73.2	1	30	73.2
37	36		NL			6	51	1	6	51
38	37		NL			6	45	1	6	45
39	38		NL			50	69	1	50	69
40	39		NL			40	78	1	40	78
41	40		NL			48	477.6	1	48	477.6
42	41		NL			54	137.7	1	54	137.7
43	42		NL			804	3708	1	804	3708
44	43		NL			72	284.4	1	72	284.4
45	44		NL			120	386.4	1	120	386.4
46	45		NL			96	360	1	96	360
47	46		NL			72	109.44	1	72	109.44
48	47		NL			18	60.12	1	18	60.12
49	48		NL			20	100.4	1	20	100.4
50	49		NL			24	44.88	1	24	44.88
51	50		NL			36	36	1	36	36
52	51		NL			72	62.64	1	72	62.64
53	52		NL			112	131.68	1	112	131.68
54	53		NL			96	249.6	1	96	249.6
55	54		NL			130	189.8	1	130	189.8
56	55		NL			30	135	1	30	135
57	56		NL			90	81	1	90	81
58	57		NL			72	178.56	1	72	178.56
59	58		NL			35	96.25	1	35	96.25
60	59		NL			35	96.25	1	35	96.25
61
62									4529	13444.18
63
Sheet2

Cell Formulas
Range	Formula
I2:I60	I2	=F2*H2
J2:J60	J2	=G2*H2
M2:N2	M2	=I62-K2
I62:J62	I62	=SUM(I2:I60)

Named Ranges
Name	Refers To	Cells
solver_adj	=Sheet2!$H$2:$H$60	I2:J2
solver_lhs1	=Sheet2!$H$2:$H$60	I2:J2
solver_lhs2	=Sheet2!$H$2:$H$60	I2:J2

 

[Kendok]

Oh my! Thnx! You save my brain! ::D