Make combinations until a require sum is reached...

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello,

I am looking a VBA collect the 6 number from the 6 rows which sums reach 15 in this given example (but if it is possible to make VBA flexible so can be chosen any sum)

Example1 picks 5 numbers from (row 3,4,5,6 &7 from 5 rows) from cells B3:B7 which sums =13 then check row 8 from B8:J8 adding each number with row (with cells B3:B7 total) if sum target 15 match list them in L2:Q2 as B3:B7 Total is 13 there is no number 2 in row 8 so no sum match found =15

Check this example1 below


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322
44117693502
50231542101611
673480214913
72014320116105
81201355314176
Hoja7


Example2 picks 4 numbers from (row 3,4,5 & 6 from 4 rows) from cells B3:B6 an one next number from row7 = 2 now sums are =11 then check again with row 8 from B8:J8 adding each number with row (with cells B3:B6 +C7 total) if sum target 15 match as B3:B6 +C7Total is 11 there is no number 4 in row 8 so no sum match found =15


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322
44117693502
50231542101611
673480214913
72014320116105
81201355314176
Hoja7


Example3 repeat the step above pick next number in row 7 = 14 now 11+14 =25 no match 15 found


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322
44117693502
50231542101611
673480214913
72014320116105
81201355314176
Hoja7


Example4 repeat the step above pick next number in row 7 = 3 now 11+3 =14 and in row 8 found number 1 so 14+1 = 15 match found list it in L2:Q2


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322040731
44117693502
50231542101611
673480214913
72014320116105
81201355314176
Hoja7


Example5 repeat the step above pick next number in row 7 = 20 now 11+20 =31 no match 15 found


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322040731
44117693502
50231542101611
673480214913
72014320116105
81201355314176
Hoja7


Example6 repeat the step above pick next number in row 7 = 1 now 11+1 =12 and in row 8 found number 3 so 12+3 = 15 match found list it in L3:Q3


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322040731
44117693502040713
50231542101611
673480214913
72014320116105
81201355314176
Hoja7


Here are some more matches but not all


Book1
ABCDEFGHIJKLMNOPQ
1
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322040731
44117693502040713
50231542101611040335
673480214913040353
72014320116105040425
81201355314176040416
9040821
10040803
11040056
12040236
13040155
14042711
15042333
16042423
17042036
18042225
Hoja7


Please need VBA solution to get all combinations

Thank you all

Excel 2000
Regards,
Moti
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Hi Moti,
give this a try
Code: 
Sub moti_11_2016()
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim mynumbers As Variant
Dim check As Long
Dim nextrow As Long
Dim lastrow As Long
check = Range("a1").Value
mynumbers = Range("b3:j8").Value
For x1 = 1 To 9
    For x2 = 1 To 9
        For x3 = 1 To 9
            For x4 = 1 To 9
                For x5 = 1 To 9
                    For x6 = 1 To 9
                        If (mynumbers(1, x1) + mynumbers(2, x2) + mynumbers(3, x3) + mynumbers(4, x4) + mynumbers(5, x5) + mynumbers(6, x6)) = check Then
                            nextrow = Cells(Rows.Count, 12).End(xlUp).Row + 1
                            Cells(nextrow, 12).Value = mynumbers(1, x1)
                            Cells(nextrow, 13).Value = mynumbers(2, x2)
                            Cells(nextrow, 14).Value = mynumbers(3, x3)
                            Cells(nextrow, 15).Value = mynumbers(4, x4)
                            Cells(nextrow, 16).Value = mynumbers(5, x5)
                            Cells(nextrow, 17).Value = mynumbers(6, x6)
                        End If
                    Next x6
                Next x5
            Next x4
        Next x3
    Next x2
Next x1
lastrow = Cells(Rows.Count, 12).End(xlUp).Row
MsgBox ((lastrow - 2) & " combinations found")
End Sub

Put in cell A1 the sum you want as target

I think speed may be improved introducing a check if sum excedes 15 before most inner loop but it requires a test: checking and checking slows down macro so I cannot forecast net result.

Hope this helps
 
Upvote 0
B___P said:
Hi Moti,
give this a try
Code: 
Sub moti_11_2016()
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim mynumbers As Variant
Dim check As Long
Dim nextrow As Long
Dim lastrow As Long
check = Range("a1").Value
mynumbers = Range("b3:j8").Value
For x1 = 1 To 9
    For x2 = 1 To 9
        For x3 = 1 To 9
            For x4 = 1 To 9
                For x5 = 1 To 9
                    For x6 = 1 To 9
                        If (mynumbers(1, x1) + mynumbers(2, x2) + mynumbers(3, x3) + mynumbers(4, x4) + mynumbers(5, x5) + mynumbers(6, x6)) = check Then
                            nextrow = Cells(Rows.Count, 12).End(xlUp).Row + 1
                            Cells(nextrow, 12).Value = mynumbers(1, x1)
                            Cells(nextrow, 13).Value = mynumbers(2, x2)
                            Cells(nextrow, 14).Value = mynumbers(3, x3)
                            Cells(nextrow, 15).Value = mynumbers(4, x4)
                            Cells(nextrow, 16).Value = mynumbers(5, x5)
                            Cells(nextrow, 17).Value = mynumbers(6, x6)
                        End If
                    Next x6
                Next x5
            Next x4
        Next x3
    Next x2
Next x1
lastrow = Cells(Rows.Count, 12).End(xlUp).Row
MsgBox ((lastrow - 2) & " combinations found")
End Sub

Put in cell A1 the sum you want as target

I think speed may be improved introducing a check if sum excedes 15 before most inner loop but it requires a test: checking and checking slows down macro so I cannot forecast net result.

Hope this helps
Click to expand...
Hello B___P, you are too good, really I appreciate your help a lot. I check extracting few sums like minimum with sum 1 it generate 6 combinations, with sum 15 it generate 3140 combinations, with sum 50 it generate 8005 combinations, and finally with maximum sum 186 it generate 1 combinations, all results are accurate
And working quickly it is hardly thanking seconds to extract all sum combinations nice code.

Have a nice day ahead

My Regards,
Moti


 
Upvote 0
Hello, with the layout data shown in cells B3:J8 the below macro generate Putting in cell A1 the target sum generate combinations in the column L:Q, in below example shown combinations generated with sum 1 = 6


Book1
ABCDEFGHIJKLMNOPQ
11
2n1n2n3n4n5n6n7n8n9R1R2R3R4R5R6
304921562322010000
44117693502000001
50231542101611000010
673480214913000100
72014320116105001000
81201355314176100000
9
10
Hoja1


Code: 
Sub moti_11_2016()
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim mynumbers As Variant
Dim check As Long
Dim nextrow As Long
Dim lastrow As Long
check = Range("a1").Value
mynumbers = Range("b3:j8").Value
For x1 = 1 To 9
    For x2 = 1 To 9
        For x3 = 1 To 9
            For x4 = 1 To 9
                For x5 = 1 To 9
                    For x6 = 1 To 9
                        If (mynumbers(1, x1) + mynumbers(2, x2) + mynumbers(3, x3) + mynumbers(4, x4) + mynumbers(5, x5) + mynumbers(6, x6)) = check Then
                            nextrow = Cells(Rows.Count, 12).End(xlUp).Row + 1
                            Cells(nextrow, 12).Value = mynumbers(1, x1)
                            Cells(nextrow, 13).Value = mynumbers(2, x2)
                            Cells(nextrow, 14).Value = mynumbers(3, x3)
                            Cells(nextrow, 15).Value = mynumbers(4, x4)
                            Cells(nextrow, 16).Value = mynumbers(5, x5)
                            Cells(nextrow, 17).Value = mynumbers(6, x6)
                        End If
                    Next x6
                Next x5
            Next x4
        Next x3
    Next x2
Next x1
lastrow = Cells(Rows.Count, 12).End(xlUp).Row
MsgBox ((lastrow - 2) & " combinations found")
End Sub

What I want is it possible to have summary in the column L instead generating combinations with each sum individually the few sum I generated with 0 to 5 and placed value in M2:M8 Like below: Min sum could be 0 and max = 186


Book1
ABCDEFGHIJKLM
1
2n1n2n3n4n5n6n7n8n9SUMSUM FOUND
30492156232201
4411769350216
50231542101611220
673480214913350
720143201161054103
812013553141765187
9
10
Hoja2


Regards,
Moti
 
Upvote 0
Hi Moti,
here the code you need
Code: 
Sub moti_11_2016_OnlyReport()
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim mynumbers As Variant
Dim check As Long
'Dim nextrow As Long
'Dim lastrow As Long
Dim tot As Long
tot = 0
For check = 0 To 186
'check = Range("a1").Value
mynumbers = Range("b3:j8").Value
For x1 = 1 To 9
    For x2 = 1 To 9
        For x3 = 1 To 9
            For x4 = 1 To 9
                For x5 = 1 To 9
                    For x6 = 1 To 9
                        If (mynumbers(1, x1) + mynumbers(2, x2) + mynumbers(3, x3) + mynumbers(4, x4) + mynumbers(5, x5) + mynumbers(6, x6)) = check Then
                            tot = tot + 1
                            'nextrow = Cells(Rows.Count, 12).End(xlUp).Row + 1
                            'Cells(nextrow, 12).Value = mynumbers(1, x1)
                            'Cells(nextrow, 13).Value = mynumbers(2, x2)
                            'Cells(nextrow, 14).Value = mynumbers(3, x3)
                            'Cells(nextrow, 15).Value = mynumbers(4, x4)
                            'Cells(nextrow, 16).Value = mynumbers(5, x5)
                            'Cells(nextrow, 17).Value = mynumbers(6, x6)
                        End If
                    Next x6
                Next x5
            Next x4
        Next x3
    Next x2
Next x1
'lastrow = Cells(Rows.Count, 12).End(xlUp).Row
'MsgBox ((lastrow - 2) & " combinations found")
Cells(3 + check, 12).Value = check
Cells(3 + check, 13).Value = tot
tot = 0
Next check
MsgBox ("E N D")
End Sub

It is the former one with amendments

Have a nice time
 
Upvote 0
B___P said:
Hi Moti,
here the code you need
Code: 
Sub moti_11_2016_OnlyReport()
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim mynumbers As Variant
Dim check As Long
'Dim nextrow As Long
'Dim lastrow As Long
Dim tot As Long
tot = 0
For check = 0 To 186
'check = Range("a1").Value
mynumbers = Range("b3:j8").Value
For x1 = 1 To 9
    For x2 = 1 To 9
        For x3 = 1 To 9
            For x4 = 1 To 9
                For x5 = 1 To 9
                    For x6 = 1 To 9
                        If (mynumbers(1, x1) + mynumbers(2, x2) + mynumbers(3, x3) + mynumbers(4, x4) + mynumbers(5, x5) + mynumbers(6, x6)) = check Then
                            tot = tot + 1
                            'nextrow = Cells(Rows.Count, 12).End(xlUp).Row + 1
                            'Cells(nextrow, 12).Value = mynumbers(1, x1)
                            'Cells(nextrow, 13).Value = mynumbers(2, x2)
                            'Cells(nextrow, 14).Value = mynumbers(3, x3)
                            'Cells(nextrow, 15).Value = mynumbers(4, x4)
                            'Cells(nextrow, 16).Value = mynumbers(5, x5)
                            'Cells(nextrow, 17).Value = mynumbers(6, x6)
                        End If
                    Next x6
                Next x5
            Next x4
        Next x3
    Next x2
Next x1
'lastrow = Cells(Rows.Count, 12).End(xlUp).Row
'MsgBox ((lastrow - 2) & " combinations found")
Cells(3 + check, 12).Value = check
Cells(3 + check, 13).Value = tot
tot = 0
Next check
MsgBox ("E N D")
End Sub

It is the former one with amendments

Have a nice time
Click to expand...
Thank you B___P, it is big help working as treat!! 100%OK!!

I really appreciate a lot all the help you gave me

Have a good time and Good Luck To You

Kind Regards,
Moti :)


 
Upvote 0
Hi Moti,
last code was intended to leave you the chance to merge combinations and report, if you need only a report following one is a much faster code that does the job in only one pass.

Code: 
Sub moti_11_2016_OnlyReport1Pass()
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim mynumbers As Variant
Dim check As Long
Dim x As Long
Dim check1(0 To 186, 1 To 2) As Variant
For x = 0 To UBound(check1, 1)
    check1(x, 1) = x
    check1(x, 2) = 0
Next x
mynumbers = Range("b3:j8").Value
For x1 = 1 To 9
    For x2 = 1 To 9
        For x3 = 1 To 9
            For x4 = 1 To 9
                For x5 = 1 To 9
                    For x6 = 1 To 9
                        check = (mynumbers(1, x1) + mynumbers(2, x2) + mynumbers(3, x3) + mynumbers(4, x4) + mynumbers(5, x5) + mynumbers(6, x6)) ' = check Then
                            check1(check, 2) = check1(check, 2) + 1
                    Next x6
                Next x5
            Next x4
        Next x3
    Next x2
Next x1
Range("l3:m189") = check1
MsgBox ("E N D")
End Sub

Have a nice time
 
Last edited:
Upvote 0
B___P said:
Hi Moti,
last code was intended to leave you the chance to merge combinations and report, if you need only a report following one is a much faster code that does the job in only one pass.


Have a nice time
Click to expand...
Thank you B___P, this is much faster and it works perfect with given example which max sum is 186, when max sum is higher than 186, it stop at the following line (check1(check, 2) = check1(check, 2) + 1) also please can you guide how can I change if I want result in Q:R or Y:Z instead L & M

Thank you

Have a nice day

Kind Regards,
Moti


 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Locked
  • Question Question
formula for randomly choosing an option
Replies
1
Views
163
Fluff
Fluff
G
  • Solved
Formula or macro to retrieve cell above to replace zero
Replies
3
Views
96
Peter_SSs
Peter_SSs
ibmy
  • Solved
Count number of occurence of value with condition
2
Replies
10
Views
303
Alex Blakenburg
A
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
118
RoryA
RoryA
F
  • Solved
Formula to find location of second row from the bottom containing specific text
Replies
5
Views
108
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top