Count Odd & Even Numbers from A Loop

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

Good evening,

What I am trying to do is to loop through ALL 6 number combinations and count how many Odd & Even numbers there are in each of the 6 positions.
For example, for number TEN I would like the total combinations where number TEN is Odd in position ONE, then number TEN is Even in position ONE, then number TEN is Odd in position TWO, then number TEN is Even in position TWO etc upto and including where number TEN is Odd in position SIX, then number TEN is Even in position SIX.
Obviously number TEN is Even, but out of the TWELVE columns of data for each of the numbers there will be SIX with a figure in it and SIX showing ZERO.
Here is the code I have so far but can't quite get it to work.
Thanks in advance.

Option Explicit
Option Base 1

Sub Odds_and_Evens_by_Position()
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
    Dim OddA As Long, OddB As Long, OddC As Long
    Dim OddD As Long, OddE As Long, OddF As Long
    Dim EvenA As Long, EvenB As Long, EvenC As Long
    Dim EvenD As Long, EvenE As Long, EvenF As Long
    Dim n As Long
    With Sheets("Odd & Even").Select
        Range("B:N").ClearContents
        Range("B2").Select
        For n = 1 To 30
            For A = 1 To 25
                If A Mod 2 = 1 Then OddA = OddA
                If A Mod 2 = 0 Then EvenA = EvenA
                For B = A + 1 To 26
                    If B Mod 2 = 1 Then OddB = OddB
                    If B Mod 2 = 0 Then EvenB = EvenB
                    For C = B + 1 To 27
                        If C Mod 2 = 1 Then OddC = OddC
                        If C Mod 2 = 0 Then EvenC = EvenC
                        For D = C + 1 To 28
                            If D Mod 2 = 1 Then OddD = OddD
                            If D Mod 2 = 0 Then EvenD = EvenD
                            For E = D + 1 To 29
                                If E Mod 2 = 1 Then OddE = OddE
                                If E Mod 2 = 0 Then EvenE = EvenE
                                For F = E + 1 To 30
                                    If F Mod 2 = 1 Then OddF = OddF
                                    If F Mod 2 = 0 Then EvenF = EvenF
                                    OddA = OddA + 1
                                    EvenA = EvenA + 1
                                    OddB = OddB + 1
                                    EvenB = EvenB + 1
                                    OddC = OddC + 1
                                    EvenC = EvenC + 1
                                    OddD = OddD + 1
                                    EvenD = EvenD + 1
                                    OddE = OddE + 1
                                    EvenE = EvenE + 1
                                    OddF = OddF + 1
                                    EvenF = EvenF + 1
                                Next F
                            Next E
                        Next D
                    Next C
                Next B
            Next A
        Next
        For n = 1 To 30
            With ActiveCell
                .Offset(2, 0).Value = n
                .Offset(2, 1).Value = OddA
                .Offset(2, 2).Value = EvenA
                .Offset(2, 3).Value = OddB
                .Offset(2, 4).Value = EvenB
                .Offset(2, 5).Value = OddC
                .Offset(2, 6).Value = EvenC
                .Offset(2, 7).Value = OddD
                .Offset(2, 8).Value = EvenD
                .Offset(2, 9).Value = OddE
                .Offset(2, 10).Value = EvenE
                .Offset(2, 11).Value = OddF
                .Offset(2, 12).Value = EvenF
                .Offset(1, 0).Select
            End With
        Next n
    End With
End Sub

 

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

OK, thanks anyway JackDanIce for your time..

For others that might be able to help.
The results are showing that obviously number TEN being EVEN there are none of the total combinations from C(30,6) in position 1 ODD. There are however 575,757 combinations that have number TEN in the first EVEN position.
Likewise, there are 4,914 combinations that have number TEN in position 5 EVEN.

Thanks in advance.

 

[pgc01]

Hi

Try this for number 10

Option Explicit

Const n As Long = 49 ' total number of elements
Const p As Long = 6  ' how many taken at a time

Dim vElements As Variant ' array with total the set of elements
Dim vResult As Variant ' array with the present combination
Dim vTotal As Variant ' array with the accumulated counts of the number checked

Sub Combinations()
Dim lN As Long ' number checked

vElements = Evaluate("transpose(row(1:" & n & "))")
ReDim vResult(1 To p)
ReDim vTotal(1 To p) As Variant

' calculate the accumulated total for the numbers that is being checked
lN = 10 ' number checked
Call CombinationsNP(n, lN, 1, 1)

' write the result
Range("A2").Offset(, IIf(lN Mod 2, 0, 1)).Resize(1, 2 * p - 1) = Split(Join(vTotal, ",,"), ",")
End Sub

Sub CombinationsNP(n As Integer, lN As Long, iElement As Integer, iIndex As Integer)
Dim i As Long, j As Long

For i = iElement To n
    vResult(iIndex) = vElements(i)
    If iIndex = p Then
        For j = 1 To p
            If vResult(j) = lN Then vTotal(j) = vTotal(j) + 1
        Next j
    Else
        Call CombinationsNP(n, lN, i + 1, iIndex + 1)
    End If
Next i
End Sub

 

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

Thanks pgc01,

Yes that does indeed produce the correct result for the number TEN, but for some reason it is showing as text as opposed to a value.
I tried adding a +0 in a few places in the code to get it to return a value but couldn't.
I will study your code and see if I can adapt it for EACH of the 49 numbers.
Thanks again, it is appreciated.

 

[pgc01]

Hi

Try this code for the 49 elements:

Option Explicit
Const n As Long = 49 ' total number of elements
Const p As Long = 6  ' how many taken at a time

Dim vElements(1 To 49) As Long  ' array with total the set of elements
Dim vResult(1 To 6) As Long ' array with the present combination
Dim vTotals(1 To 49, 1 To 12) As Long ' array with the accumulated counts of the number checked

Sub Combinations()
Dim j As Long

Erase vElements, vResult, vTotals
For j = 1 To n: vElements(j) = j: Next j
Call CombinationsNP(1, 1)
Range("a1").Resize(n, 2 * p) = vTotals
End Sub

Sub CombinationsNP(iElement As Integer, iIndex As Integer)
Dim i As Integer, j As Integer

For i = iElement To n
    vResult(iIndex) = vElements(i)
    If iIndex = p Then
        For j = 1 To p
            vTotals(vResult(j), 2 * j - vResult(j) Mod 2) = vTotals(vResult(j), 2 * j - vResult(j) Mod 2) + 1
        Next j
    Else
        Call CombinationsNP(i + 1, iIndex + 1)
    End If
Next i
End Sub

 

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

Deleted because it posted it twice for some reason, SORRY!

 

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

That's GREAT,

Try this code for the 49 elements:

Just one thing though, when I ran it again it DOUBLED ALL the numbers?
I deleted the 12 columns prior to running it again as well but it still kept adding the true figure to the previous figures?
I think I worked it out by using Erase vTotals just prior to End Sub, is that right?
Anyway it works great.
The final thing I will have a go at is putting the ball number in the first column and then the totals in the 13th column for each number and at the bottom of each column.
A big thanks again.

 

[pgc01]

I'm glad it helped.

You are right. There are global arrays in the code and so if you want to run the code again you should clear them. You can do it by pressing reset but just in case someone uses the code and forgets, I edited the code and added an Erase statement.

 

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

Hi pgc01,

The final thing I will have a go at is putting the ball number in the first column and then the totals in the 14th column for each number.

I managed to do the two things above by adding the code:-

    Range("A1").Offset(0, 1).Resize(n, 2 * p) = vTotals
    For z = 1 To 49
        With ActiveCell
            .Offset(0, 0).Value = z
            .Offset(0, 13).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
            .Offset(0, 13).Value = .Offset(0, 13).Value
            .Offset(1, 0).Select
        End With
    Next

It is probably not the most efficient way of doing it or how you would have done it but at least it works and gives the correct results.
You would probably have used a variable for the totals.
I just want to say once again a big thank you for your time and effort, it is appreciated.

 

[pgc01]

Hi

Yes, I would do it similarly, but I would nor use the Select.

For ex., assuming the table starts in C3:

...
Call CombinationsNP(1, 1)
With Range("C3")
    .Offset(0, 1).Resize(n, 2 * p) = vTotals
    .Resize(49, 1).FormulaR1C1 = "=ROWS(R" & .Row & ":R)"
    .Resize(49, 1).Value = .Resize(49, 1).Value
    .Offset(0, 13).Resize(49, 1).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
    .Offset(0, 13).Resize(49, 1).Value = .Offset(0, 13).Resize(49, 1).Value
    .Offset(49, 1).Resize(1, 12).FormulaR1C1 = "=SUM(R[-49]C:R[-1]C)"
    .Offset(49, 1).Resize(1, 12).Value = .Offset(49, 1).Resize(1, 12).Value
End With
End Sub
...

Remark: the only interest in calculating the row totals is to confirm that there's no error in the value, because we already know that due to the symmetry of the problem all numbers will appear an equal number of times, equal to Combin(49,6)*6/49=1712304

 

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

Thank you so much pgc01,

I like, rightly or wrongly selecting A1 at the start.
I just amended the code slightly by replacing the 49 with the Const n variable.
Is this a better way of coding because if the code has to be changed there is therefore less to change?
I know this probably doesn't apply to the columns used for the totals though like 12 & 13.
Obviously I couldn't do that with the formula part beacause it is a formula.

Here is the amended code:-

    Range("A1").Select
    Erase vElements, vResult, vTotals
    For j = 1 To n: vElements(j) = j: Next j
    Call CombinationsNP(1, 1)
    With ActiveCell
        .Offset(0, 1).Resize(n, 2 * p) = vTotals
        .Resize(n, 1).FormulaR1C1 = "=ROWS(R" & .Row & ":R)"
        .Resize(n, 1).Value = .Resize(n, 1).Value
        .Offset(0, 13).Resize(n, 1).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
        .Offset(0, 13).Resize(n, 1).Value = .Offset(0, 13).Resize(n, 1).Value
        .Offset(n, 1).Resize(1, 12).FormulaR1C1 = "=SUM(R[-49]C:R[-1]C)"
        .Offset(n, 1).Resize(1, 12).Value = .Offset(n, 1).Resize(1, 12).Value
    End With

This is an excellent bit of code pgc01 and I will definitely keep it for future use.
BTW, the remark you made is absolutely right.

Thanks again.
All the best.