Total sets of numbers while looping through.

[S.H.A.D.O.]

Good afternoon,

I am trying to work out how many sets of numbers appear in total when looping through all combinations.

There are 10 sets, comprising of...

01 & 10 / 02 & 20 / 03 & 30 / 04 & 40 / 12 & 21 /
13 & 31 / 14 & 41 / 23 & 32 / 24 & 42 / 34 & 43

...what I would like to know is how many of the sets in total appear in...

0 sets, this means that NO combinations contain ANY of the 10 sets.
1 sets, this means that ONLY 1 of ANY of the 10 sets appears in ANY combination.
2 sets, this means that ONLY 2 of ANY of the 10 sets appears in ANY combination.
3 sets, this means that ONLY 3 of ANY of the 10 sets appears in ANY combination.

I have tried using case statements but I couldn't seem to get that to work, I have tried grouping the sets, but to no avail either.

Here is some code that loops through all the combinations, it is obtaining the data above that I am stuck on.

Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 49
Sub Sum_Total_Groups()
    Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer
    Dim n As Integer
    Dim nType(1 To 4) As Double
    Dim Total As Long
    Dim Map(1 To 4) As Double
    Cells(1, 1).Select
    For A = MinA To MaxF - 5
        For B = A + 1 To MaxF - 4
            For C = B + 1 To MaxF - 3
                For D = C + 1 To MaxF - 2
                    For E = D + 1 To MaxF - 1
                        For F = E + 1 To MaxF
                        
'                       Maybe code goes here?
                        
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A
    For n = LBound(nType) To UBound(nType)
    Total = Total + nType(n)
        ActiveCell.Offset(n - LBound(nType), 0).Value = Map(n)
        ActiveCell.Offset(n - LBound(nType), 1).Value = nType(n)
    Next n
    ActiveCell.Offset(n - LBound(nType), 1).Value = Total
End Sub

I hope this makes sense.
Thanks in advance.

 

[oldbrewer]

do you have 43 numbers
do the combinations run from 01-02 to 42-43

if so you have 903 combinations
and you want to know how many do not contain 1/10 2/20 3/30 etc ? is this correct

 

[oldbrewer]

42	43	43
									1	10
									2	20
861									3	30
									4	40
									12	21
									13	31
									14	41
									23	32
	this macro tells you that 861 combinations do not match			24	42
	any of the selected pairs						34	43
	reallly I do not understand what you want
	For j = 1 To 42
	For k = j + 1 To 43
	Cells(1, 1) = j
	Cells(1, 2) = k
	If Cells(1, 2) = Cells(1, 3) Then GoTo 100
	counter = counter + 1
	100 Next k
	Next j
	Cells(5, 1) = counter
	End Sub

<colgroup><col width="64" span="12" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[S.H.A.D.O.]

Thanks for the reply oldbrewer,

do you have 43 numbers
do the combinations run from 01-02 to 42-43

There are 49 numbers running from numbers 1 to 49.
The combinations run from 01,02,03,04,05,06 to 44,45,46,47,48,49.

if so you have 903 combinations
and you want to know how many do not contain 1/10 2/20 3/30 etc ? is this correct

For the 0 sets that is correct, then the same theory applies to the other 3 criteria.

Thanks in advance.

 

[oldbrewer]

1

10

2

20

3

30

4

40

12

21

13

31

14

41

23

32

the macro below has calculated the number

24

42

of sets of 2 from the list on the right

34

43

the total number of combinations

is correct at 13,983,816

Dim aa(6), mmm(20), nnn(20), matchmatch(4)

For jjj = 1 To 20

mmm(jjj) = Cells(jjj, 12)

nnn(jjj) = Cells(jjj, 13)

Next jjj

For a = 1 To 44

For b = a + 1 To 45

For c = b + 1 To 46

For d = c + 1 To 47

For e = d + 1 To 48

For f = e + 1 To 49

aa(1) = a

12244596

0 sets

aa(2) = b

1694910

1 set

aa(3) = c

44190

2 sets

aa(4) = d

120

3 sets

aa(5) = e

13983816

total

aa(6) = f

For jj = 1 To 5

For kk = jj + 1 To 6

try1 = aa(jj)

try2 = aa(kk)

For mm = 1 To 10

If try1 = mmm(mm) And try2 = nnn(mm) Then Match = Match + 1

If try2 = mmm(mm) And try1 = nnn(mm) Then Match = Match + 1

Next mm

Next kk

Next jj

If Match = 0 Then matchmatch(1) = matchmatch(1) + 1

If Match = 1 Then matchmatch(2) = matchmatch(2) + 1

If Match = 2 Then matchmatch(3) = matchmatch(3) + 1

If Match = 3 Then matchmatch(4) = matchmatch(4) + 1: Cells(33, 1) = matchmatch(4)

Match = 0

Next f

Next e

Next d

Next c

Next b

Next a

Cells(30, 1) = matchmatch(1)

Cells(31, 1) = matchmatch(2)

Cells(32, 1) = matchmatch(3)

Cells(33, 1) = matchmatch(4)

End Sub

<colgroup><col><col span="14"></colgroup><tbody>
</tbody>

 

[S.H.A.D.O.]

Thanks oldbrewer for the code.

It took an awful long time to run and only produced 13,983,816 in cell A30.

Here is the code...

Sub Sum_Total_Groups()
Dim aa(6), mmm(20), nnn(20), matchmatch(4)
    For jjj = 1 To 20
        mmm(jjj) = Cells(jjj, 12)
        nnn(jjj) = Cells(jjj, 13)
    Next jjj
    For a = 1 To 44
        For b = a + 1 To 45
            For c = b + 1 To 46
                For d = c + 1 To 47
                    For e = d + 1 To 48
                        For f = e + 1 To 49
                            aa(1) = a
                            aa(2) = b
                            aa(3) = c
                            aa(4) = d
                            aa(5) = e
                            aa(6) = f
                            For jj = 1 To 5
                                For kk = jj + 1 To 6
                                    try1 = aa(jj)
                                    try2 = aa(kk)
                                    For mm = 1 To 10
                                        If try1 = mmm(mm) And try2 = nnn(mm) Then Match = Match + 1
                                        If try2 = mmm(mm) And try1 = nnn(mm) Then Match = Match + 1
                                    Next mm
                                Next kk
                            Next jj
                            If Match = 0 Then matchmatch(1) = matchmatch(1) + 1
                            If Match = 1 Then matchmatch(2) = matchmatch(2) + 1
                            If Match = 2 Then matchmatch(3) = matchmatch(3) + 1
                            If Match = 3 Then matchmatch(4) = matchmatch(4) + 1
                            Match = 0
                        Next f
                    Next e
                Next d
            Next c
        Next b
      Next a
      Cells(30, 1) = matchmatch(1)
      Cells(31, 1) = matchmatch(2)
      Cells(32, 1) = matchmatch(3)
      Cells(33, 1) = matchmatch(4)
End Sub

Thanks in advance.

 

[oldbrewer]

were the 10 sets in eaxactly the right columns? (12 and 13 rows 1 to 10) It does take a long time as for each of 14 million combinations you have to check for the presence of 0,1,2 or 3 sets

 

[S.H.A.D.O.]

Hi oldbrewer,

I don't have any data in the Worksheet.
The idea was to somehow store the 10 different sets in the code maybe and count them for the criteria of 0 sets included to 3 sets included in the total combinations of 13,983,816.

Thanks in advance.

 

[S.H.A.D.O.]

Good evening all,

Is this the sort of problem that needs to be resolved using arrays?
By that I mean, hard code the different 10 sets of numbers within the code and then loop through and keep a running total for each of the 10 sets?
I must admit, I am at a loss on how to resolve this.

Thanks in advance.

 

[shg]

Every combination of 49 choose 6 includes 0, 1, 2, or 3 pairs of those numbers. So,

Row\Col	A​	B​	C​
1​	Pairs​	Combos​	​
2​	0​	12,200,166​	B2: =COMBIN(10, A2) * COMBIN(49 - 2*A2, 6 - 2*A2) - SUM(B3:B$6)
3​	1​	1,739,100​
4​	2​	44,430​
5​	3​	120​
6​			B6: Blank
7​	Total​	13,983,816​	B7: =SUM(B2:B5)
8​	Check​	13,983,816​	B8: =COMBIN(49, 6)