Count Numerous Matches Only Once

microsoft.public.vb.general.discussion

15 Oct 2005 9:47 AM

Paul Black

Hi Everyone,

I would like to be Able to Achieve this Using VB Please.
I have a List of Six Columns and Quite a Few Rows in the Range "B2:G?".

Each Row has Six Unique Numbers Within it.
What I would like to do, is Cycle through EVERY Combination of 3
Numbers from 24 Numbers ( 2,024 Combinations ), and Check if ANY of the
Rows in "B2:G?" Contain ANY of the 2,024 Combinations. For Example, if
the First Combination of 1,2,3 was Found in 5 Rows, I Only want it
Counted as 1 Match NOT 5 Matches. So Basically, as Soon as it Finds a
Match in ANY of my Rows "B2:G?" it Counts it as One and Exits the Loop
and Continues to the Next Combination and so on. I would then Like the
Total Number of the 2,024 Combinations ( 333 for Example ) that were
Matched Underneath the Last Entry in Column "B" But One.

Basically, there are 2,024 Combinations of 3 Numbers from 24 Numbers [
Combin(24,3) ] :-
01 02 03
01 02 04
01 02 05
01 02 06
....
21 22 23
21 22 24
21 23 24
22 23 24
I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
of the Combinations are Included in ANY of the Combinations in Cells
"B2:G?". As Soon as there is a Match ( 01 02 03 in the First
Combination of 01 02 03 04 05 06 for Example ), Add One to the Total,
and Stop Checking that Particular Combination in the Rest of the Cells
"B2:G?" and Continue with the Next Combination in the List ( 01 02 04
etc ) and so on.

Many Thanks in Advance.
All the Best.
Paul

15 Oct 2005 2:22 PM

Duane Bozarth

Paul Black wrote:

>
.....
> I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> of the Combinations are Included in ANY of the Combinations in Cells
> "B2:G?". As Soon as there is a Match ( 01 02 03 in the First
> Combination of 01 02 03 04 05 06 for Example ), Add One to the Total,
> and Stop Checking that Particular Combination in the Rest of the Cells
> "B2:G?" and Continue with the Next Combination in the List ( 01 02 04
> etc ) and so on.
>

Sounds like a nested loop enumerating the possibilities to me as
described.

"Exit For" will be helpful to minimize the number of passes.

Depending on unspecified conditions on the data and desired solution(s)
a sorting of the data area Then looking for and enumerating the
mismatches could possibly be a useful approach.

16 Oct 2005 1:50 AM

Someone

> I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> of the Combinations are Included in ANY of the Combinations in Cells
> "B2:G?".

It's better to do it the other way around. Calculate the combinations first,
then loop through the cells for a match. This way you only have to loop
through the cells once. A while back you asked for away to loop through
possible combinations and only display valid combinations, without testing
every possible value so it doesn't take a long time. Below are routines that
does such a thing.

The following routine returns Combin(n, 3), expand as needed.

' nC3
'
'   Gets nC3
'
Private Function nC3(ByVal n As Long) As Long
    Dim c As Long
    Dim r1 As Long
    Dim r2 As Long
    Dim r3 As Long
    Dim r As Long

    r = 3 ' r is fixed to 3 because we have 3 loops only
    c = 0
    For r1 = 1 To n - r + 1
        For r2 = r1 + 1 To n - r + 2
            For r3 = r2 + 1 To n - r + 3
                c = c + 1
                Debug.Print r1, r2, r3
            Next
        Next
    Next
    nC3 = c
End Function

The following routine returns Combin(n, r), but you can't print each
combination. This routine executes quickly.

' Gets nCr
Private Function GetCombination(ByVal n As Long, ByVal r As Long) As Long
    Dim i As Long
    Dim Total As Long

    Total = 1
    For i = (n - r + 1) To n
        Total = Total * i
    Next
    For i = 2 To r
        Total = Total \ i
    Next
    GetCombination = Total

End Function

The following routine returns Combin(n, r), and loops and print each
combination. It doesn't do n^r loops, but nCr loops, and therefore faster
than testing n^r loops and rejecting invalid combinations.

Private Function CombinationLoop(ByVal n As Long, ByVal r As Long) As Long
    Dim c As Long
    Dim cArray() As Long
    Dim i As Long
    Dim j As Long

    ReDim cArray(0 To r) As Long

    ' Set initial values
    For i = 0 To r
        cArray(i) = i
    Next

    c = 0
    i = r
    Do While i <> 0
        ' Per combination loop
        For cArray(i) = cArray(i - 1) + 1 To n - r + i
            c = c + 1
            ' Print result
            If c <= 100 Then ' Only display the first 100 lines
                Debug.Print c; "- ";
                For j = 1 To r
                    Debug.Print cArray(j), ;
                Next
                Debug.Print ' new line
            End If
        Next
        ' Finished the innermost loop

        ' Get the next sequence

        ' Did the column reached its maximum value?
        Do While cArray(i) > n - r + i
            ' Yes, go to the previous column and increment
            i = i - 1
            cArray(i) = cArray(i) + 1
        Loop
        If i <> 0 Then
            ' Not done, set the inner most loops
            For j = i + 1 To r
                cArray(j) = cArray(j - 1) + 1
            Next
            i = r
        End If
    Loop
    CombinationLoop = c
End Function

Benchmark comparison in a compiled EXE:

Environment: Windows XP+SP2, VB6+SP5, AMD XP 2000+.

For Combin(24, 3):

i = nC3(24) ' 12.0 us, no Debug.Print
i = GetCombination(24, 3) ' 1.67 us, no Debug.Print
i = CombinationLoop(24, 3) ' 65.93 us, no Debug.Print

For Combin(24, 6):

i = GetCombination(24, 6) ' 4.75 us, no Debug.Print
i = CombinationLoop(24, 6) ' 60104.28 us, no Debug.Print, equivalent to
16.64 times/Second.

Since Combin(24, 6) = 134596, you could make an array of UDF and search that
array. Example:

' 5 Bytes
Public Type C24c6T
    v As Long
    Found As Byte
End Type
Public C24c6() As C24c6T

ReDim C24c6(GetCombination(24, 6)) As C24c6T

In CombinationLoop after "c = c + 1":

C24c6(c) = cArray(1) * cArray(2) * cArray(3) * cArray(4) * cArray(5) *
cArray(6)

Since 24^6 = 191,102,976, a Long is big enough to store the result. The
memory array would be about 5 * 134596 = 672980 Bytes.

Now that you have the array, you can do a reverse combination routine. If
you sorted the array, you could do a binary search for faster result(you
have to add an addition Index variable to the UDF), and if you save the
array to disk, you could save in startup time.

Show quoteHide quote

"Paul Black" <paul_blac***@hotmail.com> wrote in message
news:1129369624.383023.57240@g49g2000cwa.googlegroups.com...
> Hi Everyone,
>
> I would like to be Able to Achieve this Using VB Please.
> I have a List of Six Columns and Quite a Few Rows in the Range "B2:G?".
>
> Each Row has Six Unique Numbers Within it.
> What I would like to do, is Cycle through EVERY Combination of 3
> Numbers from 24 Numbers ( 2,024 Combinations ), and Check if ANY of the
> Rows in "B2:G?" Contain ANY of the 2,024 Combinations. For Example, if
> the First Combination of 1,2,3 was Found in 5 Rows, I Only want it
> Counted as 1 Match NOT 5 Matches. So Basically, as Soon as it Finds a
> Match in ANY of my Rows "B2:G?" it Counts it as One and Exits the Loop
> and Continues to the Next Combination and so on. I would then Like the
> Total Number of the 2,024 Combinations ( 333 for Example ) that were
> Matched Underneath the Last Entry in Column "B" But One.
>
> Basically, there are 2,024 Combinations of 3 Numbers from 24 Numbers [
> Combin(24,3) ] :-
> 01 02 03
> 01 02 04
> 01 02 05
> 01 02 06
> ...
> 21 22 23
> 21 22 24
> 21 23 24
> 22 23 24
> I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> of the Combinations are Included in ANY of the Combinations in Cells
> "B2:G?". As Soon as there is a Match ( 01 02 03 in the First
> Combination of 01 02 03 04 05 06 for Example ), Add One to the Total,
> and Stop Checking that Particular Combination in the Rest of the Cells
> "B2:G?" and Continue with the Next Combination in the List ( 01 02 04
> etc ) and so on.
>
> Many Thanks in Advance.
> All the Best.
> Paul
>

16 Oct 2005 5:16 PM

Paul Black

Hi Someone,

Thank you VERY Much for the Time and Effort that you have put into
Helping me, it is MOST Appreciated.
That is Exactly the Theory I am Trying to Achieve.
I will go through your Code with a Fine Tooth Comb and Try and Work Out
Exactly what Each Piece does.

If we were to Use the Following ( in an Excel SpreadSheet ) as an
Example :-
01 03 07 12 15 16
01 04 05 17 20 21
01 08 09 10 19 22
01 13 14 18 23 24
02 03 06 09 21 23
02 10 12 14 16 20
02 11 15 19 20 24
03 04 07 10 18 24
03 05 07 14 17 19
04 06 08 14 15 22
04 09 11 13 16 19
05 10 13 15 17 23
05 11 12 18 21 22
06 08 12 16 17 24
07 08 13 20 22 23

I would Ideally like to Produce a Table of the "Tested" and "Covered"
Combinations for the Following Categories Please :-
Match
2 if 2
2 if 3
2 if 4
2 if 5
2 if 6
3 if 3
3 if 4
3 if 5
3 if 6
4 if 4
4 if 5
4 if 6
5 if 5
5 if 6
6 if 6

It would be Outstanding if it could Produce a Table ( Not Sure if these
Figures are Correct ) like :-
Matched Tested      Covered
2 if 2       276           209
2 if 3       2,024        2,008
2 if 4      10,626      10,626
2 if 5      42,504      42,504
2 if 6      134,596    134,596
3 if 3      2,024        300
3 if 4     10,626       5,289
3 if 5     42,504       35,720
3 if 6     134,596     131,922
4 if 4     10,626       225
4 if 5     42,504       4,140
4 if 6     134,596     35,304
5 if 5     42,504       90
5 if 6     134,596     1,635

I am Not Interested in the Actual Combinations that are "Covered" (
Matched ), But the GRAND TOTAL of Combinations "Covered" ( Matched )
for EACH Category. In the Case of 3 if 3, there would be 2,024
Combinations "Tested" ( Because Combin(24,3) = 2,024 Combinations ) and
300 of those Combinations are "Covered" within the Combinations in the
Excel SpreadSheet.
Basically, as Soon as a Combination is Found to be "Covered" ( Matched,
Regardless of which Category is Being Calculated ) within ANY of the
Combinations in the SpreadSheet, Add One to the Total "Covered" for
that Category, and Stop Checking for that Particular Combination in the
Rest of the Combinations within the SpreadSheet, But Continue with the
Next Combination to Check if that is "Covered", and so on.
For the 5 if 5 Category for Example, there are 90 "Covered"
Combinations from the "Tested" 42,504 Combinations that are "Covered" (
Matched ) in the Combinations in the SpreadSheet.
I have Tried to make this as Clear as I can.
I am New to VBA, and Trying to Learn from a Book, which I know is
Probably Not the Best Approach. I Completely Understand if you do Not
want to go Any Further with this, and do Appreciate the Time and Effort
that you have Already Put in to get me this Far.

Many Thanks in Advance.
All the Best.
Paul

Someone wrote:
Show quoteHide quote

> > I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> > of the Combinations are Included in ANY of the Combinations in Cells
> > "B2:G?".
>
> It's better to do it the other way around. Calculate the combinations first,
> then loop through the cells for a match. This way you only have to loop
> through the cells once. A while back you asked for away to loop through
> possible combinations and only display valid combinations, without testing
> every possible value so it doesn't take a long time. Below are routines that
> does such a thing.
>
> The following routine returns Combin(n, 3), expand as needed.
>
> ' nC3
> '
> '   Gets nC3
> '
> Private Function nC3(ByVal n As Long) As Long
>     Dim c As Long
>     Dim r1 As Long
>     Dim r2 As Long
>     Dim r3 As Long
>     Dim r As Long
>
>     r = 3 ' r is fixed to 3 because we have 3 loops only
>     c = 0
>     For r1 = 1 To n - r + 1
>         For r2 = r1 + 1 To n - r + 2
>             For r3 = r2 + 1 To n - r + 3
>                 c = c + 1
>                 Debug.Print r1, r2, r3
>             Next
>         Next
>     Next
>     nC3 = c
> End Function
>
> The following routine returns Combin(n, r), but you can't print each
> combination. This routine executes quickly.
>
> ' Gets nCr
> Private Function GetCombination(ByVal n As Long, ByVal r As Long) As Long
>     Dim i As Long
>     Dim Total As Long
>
>     Total = 1
>     For i = (n - r + 1) To n
>         Total = Total * i
>     Next
>     For i = 2 To r
>         Total = Total \ i
>     Next
>     GetCombination = Total
>
> End Function
>
> The following routine returns Combin(n, r), and loops and print each
> combination. It doesn't do n^r loops, but nCr loops, and therefore faster
> than testing n^r loops and rejecting invalid combinations.
>
>
> Private Function CombinationLoop(ByVal n As Long, ByVal r As Long) As Long
>     Dim c As Long
>     Dim cArray() As Long
>     Dim i As Long
>     Dim j As Long
>
>     ReDim cArray(0 To r) As Long
>
>     ' Set initial values
>     For i = 0 To r
>         cArray(i) = i
>     Next
>
>     c = 0
>     i = r
>     Do While i <> 0
>         ' Per combination loop
>         For cArray(i) = cArray(i - 1) + 1 To n - r + i
>             c = c + 1
>             ' Print result
>             If c <= 100 Then ' Only display the first 100 lines
>                 Debug.Print c; "- ";
>                 For j = 1 To r
>                     Debug.Print cArray(j), ;
>                 Next
>                 Debug.Print ' new line
>             End If
>         Next
>         ' Finished the innermost loop
>
>         ' Get the next sequence
>
>         ' Did the column reached its maximum value?
>         Do While cArray(i) > n - r + i
>             ' Yes, go to the previous column and increment
>             i = i - 1
>             cArray(i) = cArray(i) + 1
>         Loop
>         If i <> 0 Then
>             ' Not done, set the inner most loops
>             For j = i + 1 To r
>                 cArray(j) = cArray(j - 1) + 1
>             Next
>             i = r
>         End If
>     Loop
>     CombinationLoop = c
> End Function
>
> Benchmark comparison in a compiled EXE:
>
> Environment: Windows XP+SP2, VB6+SP5, AMD XP 2000+.
>
> For Combin(24, 3):
>
> i = nC3(24) ' 12.0 us, no Debug.Print
> i = GetCombination(24, 3) ' 1.67 us, no Debug.Print
> i = CombinationLoop(24, 3) ' 65.93 us, no Debug.Print
>
> For Combin(24, 6):
>
> i = GetCombination(24, 6) ' 4.75 us, no Debug.Print
> i = CombinationLoop(24, 6) ' 60104.28 us, no Debug.Print, equivalent to
> 16.64 times/Second.
>
> Since Combin(24, 6) = 134596, you could make an array of UDF and search that
> array. Example:
>
> ' 5 Bytes
> Public Type C24c6T
>     v As Long
>     Found As Byte
> End Type
> Public C24c6() As C24c6T
>
> ReDim C24c6(GetCombination(24, 6)) As C24c6T
>
> In CombinationLoop after "c = c + 1":
>
> C24c6(c) = cArray(1) * cArray(2) * cArray(3) * cArray(4) * cArray(5) *
> cArray(6)
>
> Since 24^6 = 191,102,976, a Long is big enough to store the result. The
> memory array would be about 5 * 134596 = 672980 Bytes.
>
> Now that you have the array, you can do a reverse combination routine. If
> you sorted the array, you could do a binary search for faster result(you
> have to add an addition Index variable to the UDF), and if you save the
> array to disk, you could save in startup time.
>
>
>
>
>
> "Paul Black" <paul_blac***@hotmail.com> wrote in message
> news:1129369624.383023.57240@g49g2000cwa.googlegroups.com...
> > Hi Everyone,
> >
> > I would like to be Able to Achieve this Using VB Please.
> > I have a List of Six Columns and Quite a Few Rows in the Range "B2:G?".
> >
> > Each Row has Six Unique Numbers Within it.
> > What I would like to do, is Cycle through EVERY Combination of 3
> > Numbers from 24 Numbers ( 2,024 Combinations ), and Check if ANY of the
> > Rows in "B2:G?" Contain ANY of the 2,024 Combinations. For Example, if
> > the First Combination of 1,2,3 was Found in 5 Rows, I Only want it
> > Counted as 1 Match NOT 5 Matches. So Basically, as Soon as it Finds a
> > Match in ANY of my Rows "B2:G?" it Counts it as One and Exits the Loop
> > and Continues to the Next Combination and so on. I would then Like the
> > Total Number of the 2,024 Combinations ( 333 for Example ) that were
> > Matched Underneath the Last Entry in Column "B" But One.
> >
> > Basically, there are 2,024 Combinations of 3 Numbers from 24 Numbers [
> > Combin(24,3) ] :-
> > 01 02 03
> > 01 02 04
> > 01 02 05
> > 01 02 06
> > ...
> > 21 22 23
> > 21 22 24
> > 21 23 24
> > 22 23 24
> > I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> > of the Combinations are Included in ANY of the Combinations in Cells
> > "B2:G?". As Soon as there is a Match ( 01 02 03 in the First
> > Combination of 01 02 03 04 05 06 for Example ), Add One to the Total,
> > and Stop Checking that Particular Combination in the Rest of the Cells
> > "B2:G?" and Continue with the Next Combination in the List ( 01 02 04
> > etc ) and so on.
> >
> > Many Thanks in Advance.
> > All the Best.
> > Paul
> >

16 Oct 2005 9:46 PM

Someone

> I will go through your Code with a Fine Tooth Comb and Try and Work Out
> Exactly what Each Piece does.

It will give you a headache. If you must, the inner Do While loop processes
the carry, like adjusting 1999 to 2000. Incrementing one digit is not enough
because we are doing it manually.

> 3 if 5

This means to me 3 matches out of 5, but I don't know if your Excel rows
have always 6 cells per row. The following routine probably gives you the X
in "X if 5". I assumed you always have 6 cells per row, but test each row
individually:

Private Function GetMatchedCountPerRow(ByVal RowPos As Long, ByRef cArray()
As Long) As Long
    Dim c As Long
    Dim i As Long
    Dim j As Long

    c = 0
    For i = 1 To 6
        For j = 1 To UBound(cArray)
            If memCells(RowPos, i) = cArray(j) Then
                c = c + 1
            End If
        Next
    Next

    GetMatchedCount = c
End Function

It doesn't care about the order of the numbers, i.e., "1 3 2 4 5 6" is the
same as "3 2 1 6 5 4". memCells is a memory array variable to speed things
up that represents the data in the sheet. You fill it up at startup like
this:

Private memCells() As Long

Private Sub LoadCellsIntoMemory()
    Dim i As Long
    Dim j As Long

    ReDim memCells(1 To 100, 1 To 6) As Long

    For i = 1 To 100
        For j = 1 To 6
            memCells(i,j) = ' Add cell reference here
        Next
    Next

End Sub

To use GetMatchedCountPerRow(), call it in CombinationLoop(), after "c = c +
1" line. Here is an example usage that may or may not do what you want:

' Scan all rows
For RowPos = LBound(memCells) To UBound(memCells)
    If GetMatchedCountPerRow(RowPos, cArray) > 0 Then
        CoveredForAllRows = CoveredForAllRows + 1
        Exit For ' Don't test additional rows, go to the next combination
    End If
Next

Show quoteHide quote

"Paul Black" <paul_blac***@hotmail.com> wrote in message
news:1129482963.769838.296560@o13g2000cwo.googlegroups.com...
> Hi Someone,
>
> Thank you VERY Much for the Time and Effort that you have put into
> Helping me, it is MOST Appreciated.
> That is Exactly the Theory I am Trying to Achieve.
> I will go through your Code with a Fine Tooth Comb and Try and Work Out
> Exactly what Each Piece does.
>
> If we were to Use the Following ( in an Excel SpreadSheet ) as an
> Example :-
> 01 03 07 12 15 16
> 01 04 05 17 20 21
> 01 08 09 10 19 22
> 01 13 14 18 23 24
> 02 03 06 09 21 23
> 02 10 12 14 16 20
> 02 11 15 19 20 24
> 03 04 07 10 18 24
> 03 05 07 14 17 19
> 04 06 08 14 15 22
> 04 09 11 13 16 19
> 05 10 13 15 17 23
> 05 11 12 18 21 22
> 06 08 12 16 17 24
> 07 08 13 20 22 23
>
> I would Ideally like to Produce a Table of the "Tested" and "Covered"
> Combinations for the Following Categories Please :-
> Match
> 2 if 2
> 2 if 3
> 2 if 4
> 2 if 5
> 2 if 6
> 3 if 3
> 3 if 4
> 3 if 5
> 3 if 6
> 4 if 4
> 4 if 5
> 4 if 6
> 5 if 5
> 5 if 6
> 6 if 6
>
> It would be Outstanding if it could Produce a Table ( Not Sure if these
> Figures are Correct ) like :-
> Matched Tested      Covered
> 2 if 2       276           209
> 2 if 3       2,024        2,008
> 2 if 4      10,626      10,626
> 2 if 5      42,504      42,504
> 2 if 6      134,596    134,596
> 3 if 3      2,024        300
> 3 if 4     10,626       5,289
> 3 if 5     42,504       35,720
> 3 if 6     134,596     131,922
> 4 if 4     10,626       225
> 4 if 5     42,504       4,140
> 4 if 6     134,596     35,304
> 5 if 5     42,504       90
> 5 if 6     134,596     1,635
>
> I am Not Interested in the Actual Combinations that are "Covered" (
> Matched ), But the GRAND TOTAL of Combinations "Covered" ( Matched )
> for EACH Category. In the Case of 3 if 3, there would be 2,024
> Combinations "Tested" ( Because Combin(24,3) = 2,024 Combinations ) and
> 300 of those Combinations are "Covered" within the Combinations in the
> Excel SpreadSheet.
> Basically, as Soon as a Combination is Found to be "Covered" ( Matched,
> Regardless of which Category is Being Calculated ) within ANY of the
> Combinations in the SpreadSheet, Add One to the Total "Covered" for
> that Category, and Stop Checking for that Particular Combination in the
> Rest of the Combinations within the SpreadSheet, But Continue with the
> Next Combination to Check if that is "Covered", and so on.
> For the 5 if 5 Category for Example, there are 90 "Covered"
> Combinations from the "Tested" 42,504 Combinations that are "Covered" (
> Matched ) in the Combinations in the SpreadSheet.
> I have Tried to make this as Clear as I can.
> I am New to VBA, and Trying to Learn from a Book, which I know is
> Probably Not the Best Approach. I Completely Understand if you do Not
> want to go Any Further with this, and do Appreciate the Time and Effort
> that you have Already Put in to get me this Far.
>
> Many Thanks in Advance.
> All the Best.
> Paul
>
> Someone wrote:
>> > I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
>> > of the Combinations are Included in ANY of the Combinations in Cells
>> > "B2:G?".
>>
>> It's better to do it the other way around. Calculate the combinations
>> first,
>> then loop through the cells for a match. This way you only have to loop
>> through the cells once. A while back you asked for away to loop through
>> possible combinations and only display valid combinations, without
>> testing
>> every possible value so it doesn't take a long time. Below are routines
>> that
>> does such a thing.
>>
>> The following routine returns Combin(n, 3), expand as needed.
>>
>> ' nC3
>> '
>> '   Gets nC3
>> '
>> Private Function nC3(ByVal n As Long) As Long
>>     Dim c As Long
>>     Dim r1 As Long
>>     Dim r2 As Long
>>     Dim r3 As Long
>>     Dim r As Long
>>
>>     r = 3 ' r is fixed to 3 because we have 3 loops only
>>     c = 0
>>     For r1 = 1 To n - r + 1
>>         For r2 = r1 + 1 To n - r + 2
>>             For r3 = r2 + 1 To n - r + 3
>>                 c = c + 1
>>                 Debug.Print r1, r2, r3
>>             Next
>>         Next
>>     Next
>>     nC3 = c
>> End Function
>>
>> The following routine returns Combin(n, r), but you can't print each
>> combination. This routine executes quickly.
>>
>> ' Gets nCr
>> Private Function GetCombination(ByVal n As Long, ByVal r As Long) As Long
>>     Dim i As Long
>>     Dim Total As Long
>>
>>     Total = 1
>>     For i = (n - r + 1) To n
>>         Total = Total * i
>>     Next
>>     For i = 2 To r
>>         Total = Total \ i
>>     Next
>>     GetCombination = Total
>>
>> End Function
>>
>> The following routine returns Combin(n, r), and loops and print each
>> combination. It doesn't do n^r loops, but nCr loops, and therefore faster
>> than testing n^r loops and rejecting invalid combinations.
>>
>>
>> Private Function CombinationLoop(ByVal n As Long, ByVal r As Long) As
>> Long
>>     Dim c As Long
>>     Dim cArray() As Long
>>     Dim i As Long
>>     Dim j As Long
>>
>>     ReDim cArray(0 To r) As Long
>>
>>     ' Set initial values
>>     For i = 0 To r
>>         cArray(i) = i
>>     Next
>>
>>     c = 0
>>     i = r
>>     Do While i <> 0
>>         ' Per combination loop
>>         For cArray(i) = cArray(i - 1) + 1 To n - r + i
>>             c = c + 1
>>             ' Print result
>>             If c <= 100 Then ' Only display the first 100 lines
>>                 Debug.Print c; "- ";
>>                 For j = 1 To r
>>                     Debug.Print cArray(j), ;
>>                 Next
>>                 Debug.Print ' new line
>>             End If
>>         Next
>>         ' Finished the innermost loop
>>
>>         ' Get the next sequence
>>
>>         ' Did the column reached its maximum value?
>>         Do While cArray(i) > n - r + i
>>             ' Yes, go to the previous column and increment
>>             i = i - 1
>>             cArray(i) = cArray(i) + 1
>>         Loop
>>         If i <> 0 Then
>>             ' Not done, set the inner most loops
>>             For j = i + 1 To r
>>                 cArray(j) = cArray(j - 1) + 1
>>             Next
>>             i = r
>>         End If
>>     Loop
>>     CombinationLoop = c
>> End Function
>>
>> Benchmark comparison in a compiled EXE:
>>
>> Environment: Windows XP+SP2, VB6+SP5, AMD XP 2000+.
>>
>> For Combin(24, 3):
>>
>> i = nC3(24) ' 12.0 us, no Debug.Print
>> i = GetCombination(24, 3) ' 1.67 us, no Debug.Print
>> i = CombinationLoop(24, 3) ' 65.93 us, no Debug.Print
>>
>> For Combin(24, 6):
>>
>> i = GetCombination(24, 6) ' 4.75 us, no Debug.Print
>> i = CombinationLoop(24, 6) ' 60104.28 us, no Debug.Print, equivalent to
>> 16.64 times/Second.
>>
>> Since Combin(24, 6) = 134596, you could make an array of UDF and search
>> that
>> array. Example:
>>
>> ' 5 Bytes
>> Public Type C24c6T
>>     v As Long
>>     Found As Byte
>> End Type
>> Public C24c6() As C24c6T
>>
>> ReDim C24c6(GetCombination(24, 6)) As C24c6T
>>
>> In CombinationLoop after "c = c + 1":
>>
>> C24c6(c) = cArray(1) * cArray(2) * cArray(3) * cArray(4) * cArray(5) *
>> cArray(6)
>>
>> Since 24^6 = 191,102,976, a Long is big enough to store the result. The
>> memory array would be about 5 * 134596 = 672980 Bytes.
>>
>> Now that you have the array, you can do a reverse combination routine. If
>> you sorted the array, you could do a binary search for faster result(you
>> have to add an addition Index variable to the UDF), and if you save the
>> array to disk, you could save in startup time.
>>
>>
>>
>>
>>
>> "Paul Black" <paul_blac***@hotmail.com> wrote in message
>> news:1129369624.383023.57240@g49g2000cwa.googlegroups.com...
>> > Hi Everyone,
>> >
>> > I would like to be Able to Achieve this Using VB Please.
>> > I have a List of Six Columns and Quite a Few Rows in the Range "B2:G?".
>> >
>> > Each Row has Six Unique Numbers Within it.
>> > What I would like to do, is Cycle through EVERY Combination of 3
>> > Numbers from 24 Numbers ( 2,024 Combinations ), and Check if ANY of the
>> > Rows in "B2:G?" Contain ANY of the 2,024 Combinations. For Example, if
>> > the First Combination of 1,2,3 was Found in 5 Rows, I Only want it
>> > Counted as 1 Match NOT 5 Matches. So Basically, as Soon as it Finds a
>> > Match in ANY of my Rows "B2:G?" it Counts it as One and Exits the Loop
>> > and Continues to the Next Combination and so on. I would then Like the
>> > Total Number of the 2,024 Combinations ( 333 for Example ) that were
>> > Matched Underneath the Last Entry in Column "B" But One.
>> >
>> > Basically, there are 2,024 Combinations of 3 Numbers from 24 Numbers [
>> > Combin(24,3) ] :-
>> > 01 02 03
>> > 01 02 04
>> > 01 02 05
>> > 01 02 06
>> > ...
>> > 21 22 23
>> > 21 22 24
>> > 21 23 24
>> > 22 23 24
>> > I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
>> > of the Combinations are Included in ANY of the Combinations in Cells
>> > "B2:G?". As Soon as there is a Match ( 01 02 03 in the First
>> > Combination of 01 02 03 04 05 06 for Example ), Add One to the Total,
>> > and Stop Checking that Particular Combination in the Rest of the Cells
>> > "B2:G?" and Continue with the Next Combination in the List ( 01 02 04
>> > etc ) and so on.
>> >
>> > Many Thanks in Advance.
>> > All the Best.
>> > Paul
>> >
>

18 Oct 2005 11:02 AM

Paul Black

Hi Someone,

Once Again, Thanks VERY Much for your Response.
As you have Probably Worked Out, this is Lotto Orientated, But has
NOTHING to do with Prediction, it is Basically to Create an Information
Table from Certain Criteria.
EACH Excel Row will ALWAYS have 6 Unique Numbers. There could However,
be Four Numbers 1's in Four Different Rows of the List. The List could
Contain 2 Rows Or 50 Rows. You are Quite Right, EACH Row Must be Tested
Individually.
As you Know, I am a New to VBA, and am Finding this Hard to Follow.
Are you Saying, that a Sub Needs to be Written that Calls the Various
Functions that you have Written, that will Pull Everything Together. If
this is the Case, I don't think I will be Able to Achieve this on my
Own Unfortunately.
This is what I was Told for the Interpretation of the 3 if 5 and 4 if 5
Category :-

Quote :-
---------
You need a list of all 5-number combinations that can be constructed
from the numbers in your wheel. so if your wheel contains x unique
numbers you'll need a list of all pentads from those x numbers.

now you need to scan the wheel for each pentad in your list and compare
it with each line in the wheel to see if the line matches the pentad in
*exactly* three numbers.

let's assume that your list has e.g. 5 pentads only. then you may get
results like this:
1. pentad - 0 matches
2. pentad - 2 lines match in three numbers
3. pentad - 5 lines match in three numbers
4. pentad - 2 lines match in three numbers
5. pentad - 0 matches

that means you have 40% chance of winning nothing, 40% chance of
getting two 3-number hits and 20% chance of getting five 3-number hits.

if you were looking for 4if5 coverage then your results may look like:

1. pentad - 0 matches
2. pentad - 2 lines match in 4 numbers and 6 *other* lines match in 3
numbers
3. pentad - 4 lines match in 3 numbers
4. pentad - 2 lines match in 4 numbers and 8 *other* lines match in 3
numbers
5. pentad - 3 lines match in 4 numbers and 2 lines match in 3 numbers

then the collated results are:
20% chance of winning nothing
20% chance of getting four 3-number hits
40% chance of getting two 4-number hits *and* 6 to 8 3-number hits
20% chance of getting three 4-number hits *and* exactly two 3-number
hits
---------

I Don't Know if this Makes it Any Clearer at All.
I think this is getting Far Too Complicated and will Completely
Understand if you Don't want to Continue Any Further with this. I have
Been Trying to Find a Solution to this for MONTHS, I can Now Understand
why I haven't.
I Really do Appreciate ALL the Time & Effort that you have Put into
this.

All the VERY Best.
Paul

Someone wrote:
Show quoteHide quote

> > I will go through your Code with a Fine Tooth Comb and Try and Work Out
> > Exactly what Each Piece does.
>
> It will give you a headache. If you must, the inner Do While loop processes
> the carry, like adjusting 1999 to 2000. Incrementing one digit is not enough
> because we are doing it manually.
>
> > 3 if 5
>
> This means to me 3 matches out of 5, but I don't know if your Excel rows
> have always 6 cells per row. The following routine probably gives you the X
> in "X if 5". I assumed you always have 6 cells per row, but test each row
> individually:
>
> Private Function GetMatchedCountPerRow(ByVal RowPos As Long, ByRef cArray()
> As Long) As Long
>     Dim c As Long
>     Dim i As Long
>     Dim j As Long
>
>     c = 0
>     For i = 1 To 6
>         For j = 1 To UBound(cArray)
>             If memCells(RowPos, i) = cArray(j) Then
>                 c = c + 1
>             End If
>         Next
>     Next
>
>     GetMatchedCount = c
> End Function
>
> It doesn't care about the order of the numbers, i.e., "1 3 2 4 5 6" is the
> same as "3 2 1 6 5 4". memCells is a memory array variable to speed things
> up that represents the data in the sheet. You fill it up at startup like
> this:
>
> Private memCells() As Long
>
> Private Sub LoadCellsIntoMemory()
>     Dim i As Long
>     Dim j As Long
>
>     ReDim memCells(1 To 100, 1 To 6) As Long
>
>     For i = 1 To 100
>         For j = 1 To 6
>             memCells(i,j) = ' Add cell reference here
>         Next
>     Next
>
> End Sub
>
> To use GetMatchedCountPerRow(), call it in CombinationLoop(), after "c = c +
> 1" line. Here is an example usage that may or may not do what you want:
>
> ' Scan all rows
> For RowPos = LBound(memCells) To UBound(memCells)
>     If GetMatchedCountPerRow(RowPos, cArray) > 0 Then
>         CoveredForAllRows = CoveredForAllRows + 1
>         Exit For ' Don't test additional rows, go to the next combination
>     End If
> Next
>
>
>
>
> "Paul Black" <paul_blac***@hotmail.com> wrote in message
> news:1129482963.769838.296560@o13g2000cwo.googlegroups.com...
> > Hi Someone,
> >
> > Thank you VERY Much for the Time and Effort that you have put into
> > Helping me, it is MOST Appreciated.
> > That is Exactly the Theory I am Trying to Achieve.
> > I will go through your Code with a Fine Tooth Comb and Try and Work Out
> > Exactly what Each Piece does.
> >
> > If we were to Use the Following ( in an Excel SpreadSheet ) as an
> > Example :-
> > 01 03 07 12 15 16
> > 01 04 05 17 20 21
> > 01 08 09 10 19 22
> > 01 13 14 18 23 24
> > 02 03 06 09 21 23
> > 02 10 12 14 16 20
> > 02 11 15 19 20 24
> > 03 04 07 10 18 24
> > 03 05 07 14 17 19
> > 04 06 08 14 15 22
> > 04 09 11 13 16 19
> > 05 10 13 15 17 23
> > 05 11 12 18 21 22
> > 06 08 12 16 17 24
> > 07 08 13 20 22 23
> >
> > I would Ideally like to Produce a Table of the "Tested" and "Covered"
> > Combinations for the Following Categories Please :-
> > Match
> > 2 if 2
> > 2 if 3
> > 2 if 4
> > 2 if 5
> > 2 if 6
> > 3 if 3
> > 3 if 4
> > 3 if 5
> > 3 if 6
> > 4 if 4
> > 4 if 5
> > 4 if 6
> > 5 if 5
> > 5 if 6
> > 6 if 6
> >
> > It would be Outstanding if it could Produce a Table ( Not Sure if these
> > Figures are Correct ) like :-
> > Matched Tested      Covered
> > 2 if 2       276           209
> > 2 if 3       2,024        2,008
> > 2 if 4      10,626      10,626
> > 2 if 5      42,504      42,504
> > 2 if 6      134,596    134,596
> > 3 if 3      2,024        300
> > 3 if 4     10,626       5,289
> > 3 if 5     42,504       35,720
> > 3 if 6     134,596     131,922
> > 4 if 4     10,626       225
> > 4 if 5     42,504       4,140
> > 4 if 6     134,596     35,304
> > 5 if 5     42,504       90
> > 5 if 6     134,596     1,635
> >
> > I am Not Interested in the Actual Combinations that are "Covered" (
> > Matched ), But the GRAND TOTAL of Combinations "Covered" ( Matched )
> > for EACH Category. In the Case of 3 if 3, there would be 2,024
> > Combinations "Tested" ( Because Combin(24,3) = 2,024 Combinations ) and
> > 300 of those Combinations are "Covered" within the Combinations in the
> > Excel SpreadSheet.
> > Basically, as Soon as a Combination is Found to be "Covered" ( Matched,
> > Regardless of which Category is Being Calculated ) within ANY of the
> > Combinations in the SpreadSheet, Add One to the Total "Covered" for
> > that Category, and Stop Checking for that Particular Combination in the
> > Rest of the Combinations within the SpreadSheet, But Continue with the
> > Next Combination to Check if that is "Covered", and so on.
> > For the 5 if 5 Category for Example, there are 90 "Covered"
> > Combinations from the "Tested" 42,504 Combinations that are "Covered" (
> > Matched ) in the Combinations in the SpreadSheet.
> > I have Tried to make this as Clear as I can.
> > I am New to VBA, and Trying to Learn from a Book, which I know is
> > Probably Not the Best Approach. I Completely Understand if you do Not
> > want to go Any Further with this, and do Appreciate the Time and Effort
> > that you have Already Put in to get me this Far.
> >
> > Many Thanks in Advance.
> > All the Best.
> > Paul
> >
> > Someone wrote:
> >> > I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> >> > of the Combinations are Included in ANY of the Combinations in Cells
> >> > "B2:G?".
> >>
> >> It's better to do it the other way around. Calculate the combinations
> >> first,
> >> then loop through the cells for a match. This way you only have to loop
> >> through the cells once. A while back you asked for away to loop through
> >> possible combinations and only display valid combinations, without
> >> testing
> >> every possible value so it doesn't take a long time. Below are routines
> >> that
> >> does such a thing.
> >>
> >> The following routine returns Combin(n, 3), expand as needed.
> >>
> >> ' nC3
> >> '
> >> '   Gets nC3
> >> '
> >> Private Function nC3(ByVal n As Long) As Long
> >>     Dim c As Long
> >>     Dim r1 As Long
> >>     Dim r2 As Long
> >>     Dim r3 As Long
> >>     Dim r As Long
> >>
> >>     r = 3 ' r is fixed to 3 because we have 3 loops only
> >>     c = 0
> >>     For r1 = 1 To n - r + 1
> >>         For r2 = r1 + 1 To n - r + 2
> >>             For r3 = r2 + 1 To n - r + 3
> >>                 c = c + 1
> >>                 Debug.Print r1, r2, r3
> >>             Next
> >>         Next
> >>     Next
> >>     nC3 = c
> >> End Function
> >>
> >> The following routine returns Combin(n, r), but you can't print each
> >> combination. This routine executes quickly.
> >>
> >> ' Gets nCr
> >> Private Function GetCombination(ByVal n As Long, ByVal r As Long) As Long
> >>     Dim i As Long
> >>     Dim Total As Long
> >>
> >>     Total = 1
> >>     For i = (n - r + 1) To n
> >>         Total = Total * i
> >>     Next
> >>     For i = 2 To r
> >>         Total = Total \ i
> >>     Next
> >>     GetCombination = Total
> >>
> >> End Function
> >>
> >> The following routine returns Combin(n, r), and loops and print each
> >> combination. It doesn't do n^r loops, but nCr loops, and therefore faster
> >> than testing n^r loops and rejecting invalid combinations.
> >>
> >>
> >> Private Function CombinationLoop(ByVal n As Long, ByVal r As Long) As
> >> Long
> >>     Dim c As Long
> >>     Dim cArray() As Long
> >>     Dim i As Long
> >>     Dim j As Long
> >>
> >>     ReDim cArray(0 To r) As Long
> >>
> >>     ' Set initial values
> >>     For i = 0 To r
> >>         cArray(i) = i
> >>     Next
> >>
> >>     c = 0
> >>     i = r
> >>     Do While i <> 0
> >>         ' Per combination loop
> >>         For cArray(i) = cArray(i - 1) + 1 To n - r + i
> >>             c = c + 1
> >>             ' Print result
> >>             If c <= 100 Then ' Only display the first 100 lines
> >>                 Debug.Print c; "- ";
> >>                 For j = 1 To r
> >>                     Debug.Print cArray(j), ;
> >>                 Next
> >>                 Debug.Print ' new line
> >>             End If
> >>         Next
> >>         ' Finished the innermost loop
> >>
> >>         ' Get the next sequence
> >>
> >>         ' Did the column reached its maximum value?
> >>         Do While cArray(i) > n - r + i
> >>             ' Yes, go to the previous column and increment
> >>             i = i - 1
> >>             cArray(i) = cArray(i) + 1
> >>         Loop
> >>         If i <> 0 Then
> >>             ' Not done, set the inner most loops
> >>             For j = i + 1 To r
> >>                 cArray(j) = cArray(j - 1) + 1
> >>             Next
> >>             i = r
> >>         End If
> >>     Loop
> >>     CombinationLoop = c
> >> End Function
> >>
> >> Benchmark comparison in a compiled EXE:
> >>
> >> Environment: Windows XP+SP2, VB6+SP5, AMD XP 2000+.
> >>
> >> For Combin(24, 3):
> >>
> >> i = nC3(24) ' 12.0 us, no Debug.Print
> >> i = GetCombination(24, 3) ' 1.67 us, no Debug.Print
> >> i = CombinationLoop(24, 3) ' 65.93 us, no Debug.Print
> >>
> >> For Combin(24, 6):
> >>
> >> i = GetCombination(24, 6) ' 4.75 us, no Debug.Print
> >> i = CombinationLoop(24, 6) ' 60104.28 us, no Debug.Print, equivalent to
> >> 16.64 times/Second.
> >>
> >> Since Combin(24, 6) = 134596, you could make an array of UDF and search
> >> that
> >> array. Example:
> >>
> >> ' 5 Bytes
> >> Public Type C24c6T
> >>     v As Long
> >>     Found As Byte
> >> End Type
> >> Public C24c6() As C24c6T
> >>
> >> ReDim C24c6(GetCombination(24, 6)) As C24c6T
> >>
> >> In CombinationLoop after "c = c + 1":
> >>
> >> C24c6(c) = cArray(1) * cArray(2) * cArray(3) * cArray(4) * cArray(5) *
> >> cArray(6)
> >>
> >> Since 24^6 = 191,102,976, a Long is big enough to store the result. The
> >> memory array would be about 5 * 134596 = 672980 Bytes.
> >>
> >> Now that you have the array, you can do a reverse combination routine. If
> >> you sorted the array, you could do a binary search for faster result(you
> >> have to add an addition Index variable to the UDF), and if you save the
> >> array to disk, you could save in startup time.
> >>
> >>
> >>
> >>
> >>
> >> "Paul Black" <paul_blac***@hotmail.com> wrote in message
> >> news:1129369624.383023.57240@g49g2000cwa.googlegroups.com...
> >> > Hi Everyone,
> >> >
> >> > I would like to be Able to Achieve this Using VB Please.
> >> > I have a List of Six Columns and Quite a Few Rows in the Range "B2:G?".
> >> >
> >> > Each Row has Six Unique Numbers Within it.
> >> > What I would like to do, is Cycle through EVERY Combination of 3
> >> > Numbers from 24 Numbers ( 2,024 Combinations ), and Check if ANY of the
> >> > Rows in "B2:G?" Contain ANY of the 2,024 Combinations. For Example, if
> >> > the First Combination of 1,2,3 was Found in 5 Rows, I Only want it
> >> > Counted as 1 Match NOT 5 Matches. So Basically, as Soon as it Finds a
> >> > Match in ANY of my Rows "B2:G?" it Counts it as One and Exits the Loop
> >> > and Continues to the Next Combination and so on. I would then Like the
> >> > Total Number of the 2,024 Combinations ( 333 for Example ) that were
> >> > Matched Underneath the Last Entry in Column "B" But One.
> >> >
> >> > Basically, there are 2,024 Combinations of 3 Numbers from 24 Numbers [
> >> > Combin(24,3) ] :-
> >> > 01 02 03
> >> > 01 02 04
> >> > 01 02 05
> >> > 01 02 06
> >> > ...
> >> > 21 22 23
> >> > 21 22 24
> >> > 21 23 24
> >> > 22 23 24
> >> > I want to Cycle through EACH of the 2,024 Combinations and Check if ANY
> >> > of the Combinations are Included in ANY of the Combinations in Cells
> >> > "B2:G?". As Soon as there is a Match ( 01 02 03 in the First
> >> > Combination of 01 02 03 04 05 06 for Example ), Add One to the Total,
> >> > and Stop Checking that Particular Combination in the Rest of the Cells
> >> > "B2:G?" and Continue with the Next Combination in the List ( 01 02 04
> >> > etc ) and so on.
> >> >
> >> > Many Thanks in Advance.
> >> > All the Best.
> >> > Paul
> >> >
> >