Count & List Combinations

[sandip.dhamapurkar]

Hi!

I was wondering if it is ever possible to make combinations in excel or
access or any other software based on my criteria.

Total number I have starts from 1 to 85. I want to count and list all
possible combinations but in a specific way. For instance 1,2,3,4,5,6
is a valid combination but for me it is NOT the first number in a
combination (in this example - 1) should be present in N1 column (It
is), the second number and third number (2 and 3) are also a part of N2
and N3 but the next three numbers (4 5 and 6) are not a part of N4 N5
and N6 hence it is INVALID.

I know that all possible combinations of 6 numbers of total 85 would be
437353560
[ =COMBIN(85,6) ]

Is it possible to count how many out of 437353560 falls within my
criteria and preferably list them? Nobody can do it manually, I was
wondering if it is possible to do it using a computer program.

N1 N2 N3 N4 N5 N6
1 2 3 52 58 61
2 3 4 53 59 62
3 4 5 54 60 63
4 5 6 55 61 64
5 6 7 56 62 65
6 7 8 57 63 66
7 8 9 58 64 67
8 9 10 59 65 68
9 10 11 60 66 69
10 11 12 61 67 70
11 12 13 62 68 71
12 13 14 63 69 72
13 14 15 64 70 73
15 16 65 71 74
16 17 66 72 75
17 18 67 73 76
18 19 68 74 77
19 20 69 75 78
20 21 70 76 79
22 71 77 80
23 72 78
24 73 79
25 74
26 75
27 76
28 77
29 78

Sandy

 

[sandip.dhamapurkar]

I was searching articles on this and I found one where John W.
Vinson[MVP] says "combinations and permutations are duck soup to
Access. You don't need any code AT ALL. All you need is a cartesian
join Query!" I also found articles by Excel and Access MVPs like Tom
Ellison, Bernie Deitrick, Tom Ogilvy and few more.

Following is a code taken from Bernie's article and manipulated
according to my needs. Can anyone check if it is correct?

Sub Comb()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer

For i = 2 To Range("A65536").End(xlUp).Row
For j = 2 To Range("B65536").End(xlUp).Row
For k = 2 To Range("C65536").End(xlUp).Row
For l = 2 To Range("D65536").End(xlUp).Row
For m = 2 To Range("E65536").End(xlUp).Row
For n = 2 To Range("F65536").End(xlUp).Row

Range("H65536").End(xlUp)(2).Value = Cells(i, 1).Value & "-" & _
Cells(j, 2).Value & "-" & Cells(k, 3).Value & "-" & _
Cells(l, 4).Value & "-" & Cells(m, 5).Value & "-" & Cells(n, 6).Value
Next n
Next m
Next l
Next k
Next j
Next i

End Sub

It is is correct so far, I need to make a small change but not sure how
to do it. Per my explanation, 2,2,3,52,58,61 should also be a valid
combination but it should not as the first and second number is same
even though the fall in N1 and N2. This becomes the second criteria,
all the six numbers in a combiation should be unique. How can I modify
the above code to take care of this criteria?

Also requesting John W. Vinson[MVP] to let me know if this can be done
in access using a join query.

 

[sandip.dhamapurkar]

One more problem, the above macro returns more than 65536 combinations,
i tried changing the macro to shift the output column from H to I and
so on whenever the entire column is filled up but I am unable to do so.

Please help.

 

[Tom Ogilvy]

Sub abc()
Dim v(1 To 6) As Variant
Dim v1() As Long, inst() As Long
For i = 1 To 6
Set rng = Range(Cells(2, i), Cells(2, i).End(xlDown))
v(i) = Application.Transpose(rng.Value)
Next
cnt = 0
For i = LBound(v(1)) To UBound(v(1))
l1 = v(1)(i)
ReDim inst(1 To 6)
ReDim v1(1 To 85)
inst(1) = l1
v1(l1) = -1
For j = LBound(v(2)) To UBound(v(2))
l2 = v(2)(j)
If v1(l2) = 0 Then
v1(l2) = -1
inst(2) = l2
For k = LBound(v(3)) To UBound(v(3))
l3 = v(3)(k)
If v1(l3) = 0 Then
v1(l3) = -1
inst(3) = l3
For l = LBound(v(4)) To UBound(v(4))
l4 = v(4)(l)
If v1(l4) = 0 Then
v1(l4) = -1
inst(4) = l4
For m = LBound(v(5)) To UBound(v(5))
l5 = v(5)(m)
If v1(l5) = 0 Then
v1(l5) = -1
inst(5) = l5
For n = LBound(v(6)) To UBound(v(6))
l6 = v(6)(n)
If v1(l6) = 0 Then
v1(l6) = -1
inst(6) = l6
cnt = cnt + 1
' Cells(cnt + 10, 1).Resize(1, 6) = inst
v1(l6) = 0
End If
Next n
v1(l5) = 0
End If ' v1(l5) = 0
Next m
v1(l4) = 0
End If ' v1(l4) = 0
Next l
v1(l3) = 0
End If ' v1(l3) = 0
Next k
v1(l2) = 0
End If ' v1(l2) = 0
Next j
v1(l1) = 0
Next i
MsgBox cnt
End Sub

produced 62,717,388

In light testing, that seemed to produce the correct results. Hopefully I
haven't missed something. I am thinking it could be culled down to much
less code and more arrays, but enough for now if it works.

 

[Tom Ogilvy]

for the number I got >62.7 M , you would require almost 957 columns. so you
would be approach 4 worksheets (3.7) filled with numbers.

While it could be done, what is the Point?

 

[sandip.dhamapurkar]

Does it also take care of the uniqueness per my second criteria below?

 

[Tom Ogilvy]

Yes it does - otherwise it wouldn't be a subset of your original combinations.

Also, here is Bernie's, cleaned up to provide similar output and fixed so it
isn't slow as paint drying on a humid day (although it is still much slower
than mine because it generates all 79M possibilities and ignores those with
duplicates - it did give the same answer as my original)

Sub Comb()
'2717388 , 79227720
Dim start As Single
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim ii As Long, jj As Long
Dim cnt As Long, cnt1 As Long
Dim cnt2 As Long, v1 As Variant
Dim iii As Long, jjj As Long, kkk As Long
Dim lll As Long, mmm As Long, nnn As Long
Dim v(1 To 6) As Long, ooo As Long
cnt2 = 0
cnt1 = 0
iii = Range("A65536").End(xlUp).Row
jjj = Range("B65536").End(xlUp).Row
kkk = Range("C65536").End(xlUp).Row
lll = Range("D65536").End(xlUp).Row
mmm = Range("E65536").End(xlUp).Row
nnn = Range("F65536").End(xlUp).Row
ooo = Application.Max(iii, jjj, kkk, lll, mmm, nnn)
v1 = Range("A1").Resize(ooo, 6).Value
start = Timer
For i = 2 To iii
For j = 2 To jjj
For k = 2 To kkk
For l = 2 To lll
For m = 2 To mmm
For n = 2 To nnn
v(1) = v1(i, 1): v(2) = v1(j, 2): v(3) = v1(k, 3)
v(4) = v1(l, 4): v(5) = v1(m, 5): v(6) = v1(n, 6)
cnt = 0
For ii = 1 To 6
For jj = 1 To 6
If v(ii) = v(jj) Then
cnt = cnt + 1
End If
Next
Next
cnt2 = cnt2 + 1
' If cnt2 Mod 1000000 = 0 Then Debug.Print cnt2, (Timer - start) / 60,
Timer - start
If cnt = 6 Then
cnt1 = cnt1 + 1

'Range("H65536").End(xlUp)(2).Value = Cells(i, 1).Value & "-" & _
'Cells(j, 2).Value & "-" & Cells(k, 3).Value & "-" & _
'Cells(l, 4).Value & "-" & Cells(m, 5).Value & "-" & Cells(n, 6).Value
End If
Next n
Next m
Next l
Next k
Next j
Next i
'Debug.Print cnt1, cnt2, (Timer - start) / 60, Timer - start
Debug.Print cnt1
End Sub

 

[sandip.dhamapurkar]

Thank you

Any book on Excel VBA that you could recommend? I know the basic stuff
and I want to learn advanced programming using excel vba.

Also I going to work on a Six Sigma project for my Green Belt
Certification which will require atleast 10-15 conditions to process a
huge data. If I email you my questions, can you help me on that?

Thanks
Sandy

 

[Tom Ogilvy]

Probably easier to post them here. Then you get help from multiple experts
24/7 - you would not just get the world according to Tom <g>

Plus, you have already demo'd that you can find good information from past
answers - so you are well ahead of many.

Good books

Books by John Walkenbach (http://www.j-walk.com/ss/excel, look at the links
on the left);
John Green/Stephen Bullen/Rob Bovey (http://www.oaltd.co.uk/ - two
different books)

 

[sandip.dhamapurkar]

Thank you for the links.

I have posted a statistical question ( Subject: Finding Sets -
Difficult one ! ). Please have a look at it if you could spare sometime
for me.

Thanks
Sandy