Out of 14 numbers make all unique combinations in with only 6 numbers in the row

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,371
Office Version
  1. 2010
Hello,</SPAN></SPAN>

I got 14 numbers in cells A5:A18 these numbers are changeable every time but (but always will be the 14 numbers)</SPAN></SPAN>

I need VBA code, which can generate all possible unique combinations with 6 numbers in the columns D:I and sum of each row combination must be 6. Is it possible?</SPAN></SPAN>

Example data</SPAN></SPAN>


Book1
ABCDEFGHIJ
1
2
3
4Numbersn1n2n3n4n5n6SUM
500011046
600011406
710011226
810010416
910014016
1000014106
1140012216
1200004026
1320004206
1400002226
1520040206
1620040026
1710042006
1800020226
190022206
200111216
210110406
220110226
230114006
240112026
250112206
260104016
270104106
280102216
290140016
300140106
310120216
320122106
330402006
340400206
350202206
361110216
371112016
381112106
391104006
401100226
411102026
421102206
431140006
441120206
451040016
461040106
471002216
481020216
491022106
501400106
511202106
Sheet1


Thank you all</SPAN></SPAN>

Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Last edited:
Sort by date Sort by votes
motilulla said:
When I run the code it stop at the line below and gives the error '438'

Code: 
.Resize(UBound(lCombinations) + 1).RemoveDuplicates Columns:=(ColArray), Header:=xlNo
Click to expand...

Yes, I wasn't sure that .RemoveDuplicates with multi columns was going to work in Excel 2000.

With .AdvancedFilter instead, you can do it like this:

Code: 
With Range("D5")
    .CurrentRegion.Offset(1).ClearContents
    With .Resize(UBound(lCombinations), lNoChosen + 1)
        .Value = lTargetNumbers
       .Columns(lNoChosen + 1).FormulaR1C1 = "=SUM(RC[-" & lNoChosen & "]:RC[-1])"
'            For i = 1 To .Rows.Count
'                .Rows(i).Sort .Cells(i, 1), Header:=xlNo, Orientation:=xlLeftToRight
'            Next i
        .Offset(-1).Resize(UBound(lCombinations) + 1).AdvancedFilter Action:=xlFilterInPlace, unique:=True
    .Sort Key1:=.Columns(lNoChosen + 1), Orientation:=xlTopToBottom, Order1:=xlAscending
    End With
End With

This will produce your 314 uniques.

Alternatively, if you uncomment the three .Sort lines, you'll get my 36 uniques.
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Let's look at "uniques" ...

Here's how my code generates the combinations summing to 1:


Book1
ABCDEFGHIJKLMNO
4Numbers1236810001000
501236814001000
6012361014001000
7112381014001000
811246810001000
911246814001000
10012461014001000
11412481014001000
1201256810001000
1321256814001000
14012561014001000
15212581014001000
16212681013000001
17112681314000010
180126101314000010
19128101314000010
2013681014010000
2114681014010000
2215681014010000
23168101314000010
2423681014010000
2524681014010000
2625681014010000
27268101314000010
Sheet1


For example, the first row takes the 1st, 2nd, 3rd, 6th, 8th and 10th of your numbers, i.e. 0 0 1 0 0 0

There are 24 combinations. I sort and filter these to get the one unique combination, i.e. One "1", and five "0"s.

If you filter without first sorting, the four "uniques" are:
0 1 0 0 0 0
0 0 1 0 0 0
0 0 0 0 1 0
0 0 0 0 0 1

But what does this mean, and why not also:
1 0 0 0 0 0
0 0 0 1 0 0

Purely because of the algorithm I have chosen to generate the combinations: I am assuming order doesn't matter.

If order does matter to you (?) then we should be talking permutations, not combinations.
 
Last edited:
Upvote 0
StephenCrump said:
Let's look at "uniques" ...

Here's how my code generates the combinations summing to 1:

A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
4
Numbers
1
2
3
6
8
10
1
5
1
2
3
6
8
14
1
6
1
2
3
6
10
14
1
7
1
1
2
3
8
10
14
1
8
1
1
2
4
6
8
10
1
9
1
1
2
4
6
8
14
1
10
1
2
4
6
10
14
1
11
4
1
2
4
8
10
14
1
12
1
2
5
6
8
10
1
13
2
1
2
5
6
8
14
1
14
1
2
5
6
10
14
1
15
2
1
2
5
8
10
14
1
16
2
1
2
6
8
10
13
1
17
1
1
2
6
8
13
14
1
18
1
2
6
10
13
14
1
19
1
2
8
10
13
14
1
20
1
3
6
8
10
14
1
21
1
4
6
8
10
14
1
22
1
5
6
8
10
14
1
23
1
6
8
10
13
14
1
24
2
3
6
8
10
14
1
25
2
4
6
8
10
14
1
26
2
5
6
8
10
14
1
27
2
6
8
10
13
14
1

<TBODY>
</TBODY>




For example, the first row takes the 1st, 2nd, 3rd, 6th, 8th and 10th of your numbers, i.e. 0 0 1 0 0 0

There are 24 combinations. I sort and filter these to get the one unique combination, i.e. One "1", and five "0"s.

If you filter without first sorting, the four "uniques" are:
0 1 0 0 0 0
0 0 1 0 0 0
0 0 0 0 1 0
0 0 0 0 0 1

But what does this mean, and why not also:
1 0 0 0 0 0
0 0 0 1 0 0

Purely because of the algorithm I have chosen to generate the combinations: I am assuming order doesn't matter.

If order does matter to you (?) then we should be talking permutations, not combinations.
Click to expand...
StephenCrump, yes I see It is wrong described I wanted a permutations actually. I am sorry you got it correct. </SPAN></SPAN>

Thank you very much for explaining and clarifying the difference between permutations and combinations.</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti :)</SPAN></SPAN>
 
Upvote 0
StephenCrump said:
Yes, I wasn't sure that .RemoveDuplicates with multi columns was going to work in Excel 2000.

With .AdvancedFilter instead, you can do it like this:

Code: 
With Range("D5")
    .CurrentRegion.Offset(1).ClearContents
    With .Resize(UBound(lCombinations), lNoChosen + 1)
        .Value = lTargetNumbers
       .Columns(lNoChosen + 1).FormulaR1C1 = "=SUM(RC[-" & lNoChosen & "]:RC[-1])"
'            For i = 1 To .Rows.Count
'                .Rows(i).Sort .Cells(i, 1), Header:=xlNo, Orientation:=xlLeftToRight
'            Next i
        .Offset(-1).Resize(UBound(lCombinations) + 1).AdvancedFilter Action:=xlFilterInPlace, unique:=True
    .Sort Key1:=.Columns(lNoChosen + 1), Orientation:=xlTopToBottom, Order1:=xlAscending
    End With
End With

This will produce your 314 uniques.

Alternatively, if you uncomment the three .Sort lines, you'll get my 36 uniques.
Click to expand...
StephenCrump, I did change as per your instructions but it is not filtering generating all 3003 permutations, neither even if I uncomment the three. Sort lines; do not get your 36 uniques.</SPAN></SPAN>

If I re use the line I added it filter 314 but do not eliminate the false</SPAN></SPAN>

Please can you take a look?</SPAN></SPAN>

Thank you for your help</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Upvote 0
motilulla said:
StephenCrump, yes I see It is wrong described I wanted a permutations actually.
Click to expand...

Do you want code for unique permutations?

Unique permutations adding to 1, for example, would be:
1 0 0 0 0 0
0 1 0 0 0 0
0 0 1 0 0 0
0 0 0 1 0 0
0 0 0 0 1 0
0 0 0 0 0 1
 
Last edited:
Upvote 0
motilulla said:
I did change as per your instructions but it is not filtering generating all 3003 permutations, neither even if I uncomment the three. Sort lines; do not get your 36 uniques.

If I re use the line I added it filter 314 but do not eliminate the false
Click to expand...

Code: 
'Your line:
Range("D4:I3007").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'My Line
.Offset(-1).Resize(UBound(lCombinations) + 1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Offset(-1).Resize(UBound(lCombinations) + 1) is the range D4:J3007, i.e. same as yours, but with one extra column to allow for the sum column.

So my generalised code should behave exactly the same as your code with the hard-coded range, i.e. it should filter the 3,003 total combinations to show your 314 "uniques".

If you include my three .Sort lines, the code should show only the 36 true uniques.
 
Upvote 0
StephenCrump said:
Do you want code for unique permutations?

Unique permutations adding to 1, for example, would be:
1 0 0 0 0 0
0 1 0 0 0 0
0 0 1 0 0 0
0 0 0 1 0 0
0 0 0 0 1 0
0 0 0 0 0 1
Click to expand...
StephenCrump, I think yes that is want I am looking unique permutations 314

 
Upvote 0
StephenCrump said:
Code: 
'Your line:
Range("D4:I3007").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'My Line
.Offset(-1).Resize(UBound(lCombinations) + 1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Offset(-1).Resize(UBound(lCombinations) + 1) is the range D4:J3007, i.e. same as yours, but with one extra column to allow for the sum column.

So my generalised code should behave exactly the same as your code with the hard-coded range, i.e. it should filter the 3,003 total combinations to show your 314 "uniques".

If you include my three .Sort lines, the code should show only the 36 true uniques.
Click to expand...
StephenCrump, theatrically you are correct it must work but unfortunately what I am doing wrong cannot trace it out. I create a new sheet cleaned up code but no luck there is some parameters which may be Excel 2000 is not accepting as you are using latest version may some one has the Excel2000 yet can try it and conform what is the real problem. </SPAN></SPAN>

I really appreciate a lot you, that you are willing to solve it but it is my older version problem.</SPAN></SPAN>

Thank you so much for your help and time </SPAN></SPAN>

Kind Regards, </SPAN></SPAN>
Moti :)</SPAN></SPAN>
 
Upvote 0
motilulla said:
I think yes that is want I am looking unique permutations
Click to expand...

Code: 
Dim k As Long, row As Long
Dim N As Variant, Permutations() As Variant
Sub Test()
    
    Dim Permutation() As Variant
    Dim rng As Range
    
    Set rng = Range("A5:B8")
    N = rng.Value
    k = 6
    row = 0
    ReDim Permutation(1 To k)
    ReDim Permutations(1 To Application.Permut(Application.Sum(rng.Columns(2)), k), 1 To k)
        
    Call GetPermutations(Permutation, 1)
    
    With Range("D5")
        .CurrentRegion.Offset(1).ClearContents
        With .Resize(row, k + 1)
            .Value = Permutations
           .Columns(k + 1).FormulaR1C1 = "=SUM(RC[-" & k & "]:RC[-1])"
            .Sort Key1:=.Columns(k + 1), Orientation:=xlTopToBottom, Order1:=xlAscending
        End With
    End With
        
End Sub
Sub GetPermutations(ByVal Permutation As Variant, col As Long)
    
    Dim i As Long, j As Long
    
    For i = 1 To UBound(N)
        If N(i, 2) > 0 Then
            Permutation(col) = N(i, 1)
            If col < k Then
                N(i, 2) = N(i, 2) - 1
                Call GetPermutations(Permutation, col + 1)
                N(i, 2) = N(i, 2) + 1
            Else
                row = row + 1
                For j = 1 To k
                    Permutations(row, j) = Permutation(j)
                Next j
            End If
        End If
    Next i
       
End Sub


Book1
ABCDEFGHIJ
4NumberFreqn1n2n3n4n5n6SUM
5060000000
6140000011
7230000101
8410001001
90010001
100100001
111000001
120000022
130000112
140000202
150001012
160001102
170002002
180010012
190010102
200011002
210020002
220100012
230100102
240101002
250110002
26etc
2742121212
2842122112
2942211212
3042212112
3142221112
Sheet1
 
Last edited:
Upvote 0
StephenCrump said:
Code: 
Dim k As Long, row As Long
Dim N As Variant, Permutations() As Variant
Sub Test()
    
    Dim Permutation() As Variant
    Dim rng As Range
    
    Set rng = Range("A5:B8")
    N = rng.Value
    [COLOR=#000000]k = 6 [/COLOR] 
    row = 0
    ReDim Permutation(1 To k)
    ReDim Permutations(1 To Application.Permut(Application.Sum(rng.Columns(2)), k), 1 To k)
        
    Call GetPermutations(Permutation, 1)
    
    With Range("D5")
        .CurrentRegion.Offset(1).ClearContents
        With .Resize(row, k + 1)
            .Value = Permutations
           .Columns(k + 1).FormulaR1C1 = "=SUM(RC[-" & k & "]:RC[-1])"
            .Sort Key1:=.Columns(k + 1), Orientation:=xlTopToBottom, Order1:=xlAscending
        End With
    End With
        
End Sub
Sub GetPermutations(ByVal Permutation As Variant, col As Long)
    
    Dim i As Long, j As Long
    
    For i = 1 To UBound(N)
        If N(i, 2) > 0 Then
            Permutation(col) = N(i, 1)
            If col < k Then
                N(i, 2) = N(i, 2) - 1
                Call GetPermutations(Permutation, col + 1)
                N(i, 2) = N(i, 2) + 1
            Else
                row = row + 1
                For j = 1 To k
                    Permutations(row, j) = Permutation(j)
                Next j
            End If
        End If
    Next i
       
End Sub

A
B
C
D
E
F
G
H
I
J
4
Number
Freq
n1
n2
n3
n4
n5
n6
SUM
5
6
6
1
4
1
1
7
2
3
1
1
8
4
1
1
1
9
1
1
10
1
1
11
1
1
12
2
2
13
1
1
2
14
2
2
15
1
1
2
16
1
1
2
17
2
2
18
1
1
2
19
1
1
2
20
1
1
2
21
2
2
22
1
1
2
23
1
1
2
24
1
1
2
25
1
1
2
26
etc …
27
4
2
1
2
1
2
12
28
4
2
1
2
2
1
12
29
4
2
2
1
1
2
12
30
4
2
2
1
2
1
12
31
4
2
2
2
1
1
12

<TBODY>
</TBODY>
Click to expand...

StephenCrump, :pray: Hats off to you very intelligently done amazing idea separating the unique numbers from the string and counting the frequency of each unique number you really did the best. I checked carefully and getting all the possible matches, I find all are there in the unique permutations created by your code.</SPAN></SPAN>

I am very glad with your kind help, thank you for your time you spent to solve this difficult task.</SPAN></SPAN>

Have a great weekend and Good Luck</SPAN></SPAN>

Kind Regards, </SPAN></SPAN>
Moti :biggrin:</SPAN></SPAN>


This is just to clearly k = 6, I think this mean create permutations by 6 positions if I change k = 5, k = 4, k = 3 or k = 2 the code create permutations by the positions of k numbers. Why when I change K = 7, 8, 9 (I mean greeter than value 6) I get message "Run time error 7: out of memory" </SPAN></SPAN>
Rich (BB code): 
</SPAN></SPAN>
  Set rng = Range("A5:B8")</SPAN></SPAN>
    N = rng.Value</SPAN></SPAN>
    k = 6</SPAN></SPAN>  
    row = 0</SPAN></SPAN>
    ReDim Permutation(1 To k)</SPAN></SPAN>
    ReDim Permutations(1 To Application.Permut(Application.Sum(rng.Columns(2)), k), 1 To k)
</SPAN></SPAN>
</SPAN></SPAN>
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Need help modify to pick any first number of my choice
Replies
6
Views
335
motilulla
M
B
  • Question
Count number of rows where a dynamically growing set of columns has the specified value
Replies
0
Views
345
Bries
B
T
  • Solved
Weighted lottery help?
2
Replies
14
Views
3K
bebo021999
B
M
  • Solved
Generate combination using base line data.
Replies
1
Views
434
motilulla
M
A
  • Solved
Finding a unique value in a range and returning the value in another column of the same row, without offset / slow formulae.
Replies
8
Views
1K
AaronPMH
A

Forum statistics

Threads
1,216,091
Messages
6,128,775
Members
449,468
Latest member
AGreen17

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