Run "x" number of random draws and calculate totals against a pre-defined set.

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

Good afternoon,

What I basically want to do it to run a certain number of random combinations as input by the user via an input box.
The combinations are in the format of 6 numbers plus an extra bonus number without repitition from a pool of 59 numbers.
I would like the program to pick up the 6 numbers to check against from cells C4:H4 within the Worksheet.
I would then like the program to calculate the total matches for each random combination that matched the 6 number combination in cells C4:H4 in the format:

0 Matches
0 Matches + Extra Bonus Number
1 Matches
1 Matches + Extra Bonus Number
2 Matches
2 Matches + Extra Bonus Number
3 Matches
3 Matches + Extra Bonus Number
4 Matches
4 Matches + Extra Bonus Number
5 Matches
5 Matches + Extra Bonus Number
6 Matches

So for each random combination it will calculate the criteria above and at the end it will add all of same criteria together to give one line of results.
This will produce a single row of totals for each of the criteria above to go into cells C7:O7.
I think it could possibly involve If...Then...Else If (several of)...Else...End If, but I don't know how to go about this or how to get this to work.

It is basically a way of running "x" number of random draws against a pre-defined set of 6 numbers and producing the overall results for each of the criteria stated in a single row from cells C7:O7.

I hope I have explained this clearly enough.

Thanks in advance.

 

[Kenneth Hobson]

Sorting would be the best way to go.

It should be easy enough to get 1 random set. I would use a dictionary object method for that and remove each ball. The problem comes in when you try to not duplicate an entry. If there were not so many combinations, coding would be easier. For just 100 or so, it should not be too bad. If you use sorting then delimit the numbers sets by a character like "_" or " " would make searching for existing string sets easy.

Of course if your goal is to consider the powerball, a red ball, that might duplicate a white ball, the task becomes a bit more involved.

I'll post back when I get time to do some tests.

 

[shg]

[Table="width:, class:grid"][tr][td="bgcolor:#C0C0C0"][/td][td="bgcolor:#C0C0C0"]

D​

[/td][td="bgcolor:#C0C0C0"]

E​

[/td][td="bgcolor:#C0C0C0"]

F​

[/td][td="bgcolor:#C0C0C0"]

G​

[/td][td="bgcolor:#C0C0C0"]

H​

[/td][td="bgcolor:#C0C0C0"]

I​

[/td][td="bgcolor:#C0C0C0"]

J​

[/td][td="bgcolor:#C0C0C0"]

K​

[/td][/tr][tr][td="bgcolor:#C0C0C0"]

13​

[/td][td="bgcolor:#C4BD97"]

n1​

[/td][td="bgcolor:#C4BD97"]

n2​

[/td][td="bgcolor:#C4BD97"]

n3​

[/td][td="bgcolor:#C4BD97"]

n4​

[/td][td="bgcolor:#C4BD97"]

n5​

[/td][td="bgcolor:#C4BD97"]

n6​

[/td][td="bgcolor:#C4BD97"]

Bonus​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

14​

[/td][td]

8​

[/td][td]

7​

[/td][td]

35​

[/td][td]

13​

[/td][td]

5​

[/td][td="bgcolor:#DAEEF3"]

32​

[/td][td]

52​

[/td][td]D14:J14: {=aiRandLong(1, 59)}[/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

15​

[/td][td="bgcolor:#DAEEF3"]

18​

[/td][td]

45​

[/td][td]

10​

[/td][td]

40​

[/td][td]

46​

[/td][td]

51​

[/td][td="bgcolor:#F2DCDB"]

25​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

16​

[/td][td="bgcolor:#DAEEF3"]

2​

[/td][td]

23​

[/td][td="bgcolor:#DAEEF3"]

24​

[/td][td]

39​

[/td][td]

53​

[/td][td]

19​

[/td][td]

30​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

17​

[/td][td]

33​

[/td][td]

59​

[/td][td]

55​

[/td][td]

40​

[/td][td]

34​

[/td][td]

56​

[/td][td]

24​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

18​

[/td][td="bgcolor:#DAEEF3"]

39​

[/td][td="bgcolor:#DAEEF3"]

27​

[/td][td="bgcolor:#DAEEF3"]

29​

[/td][td]

52​

[/td][td="bgcolor:#DAEEF3"]

14​

[/td][td]

42​

[/td][td]

35​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

19​

[/td][td]

59​

[/td][td]

23​

[/td][td]

8​

[/td][td]

36​

[/td][td]

18​

[/td][td]

7​

[/td][td]

48​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

20​

[/td][td="bgcolor:#DAEEF3"]

42​

[/td][td="bgcolor:#DAEEF3"]

7​

[/td][td="bgcolor:#DAEEF3"]

38​

[/td][td]

46​

[/td][td="bgcolor:#DAEEF3"]

34​

[/td][td]

1​

[/td][td]

4​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

21​

[/td][td="bgcolor:#DAEEF3"]

51​

[/td][td="bgcolor:#DAEEF3"]

31​

[/td][td="bgcolor:#DAEEF3"]

24​

[/td][td="bgcolor:#DAEEF3"]

28​

[/td][td="bgcolor:#DAEEF3"]

34​

[/td][td]

32​

[/td][td="bgcolor:#F2DCDB"]

29​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

22​

[/td][td]

51​

[/td][td]

41​

[/td][td]

25​

[/td][td]

40​

[/td][td]

34​

[/td][td]

47​

[/td][td]

53​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

23​

[/td][td]

53​

[/td][td="bgcolor:#DAEEF3"]

44​

[/td][td="bgcolor:#DAEEF3"]

59​

[/td][td="bgcolor:#DAEEF3"]

26​

[/td][td]

57​

[/td][td]

16​

[/td][td]

32​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

24​

[/td][td="bgcolor:#DAEEF3"]

17​

[/td][td]

18​

[/td][td="bgcolor:#DAEEF3"]

12​

[/td][td]

34​

[/td][td]

26​

[/td][td]

44​

[/td][td="bgcolor:#F2DCDB"]

40​

[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]

25​

[/td][td="bgcolor:#DAEEF3"]

36​

[/td][td="bgcolor:#DAEEF3"]

53​

[/td][td="bgcolor:#DAEEF3"]

56​

[/td][td="bgcolor:#DAEEF3"]

43​

[/td][td="bgcolor:#DAEEF3"]

46​

[/td][td="bgcolor:#DAEEF3"]

44​

[/td][td]

2​

[/td][td][/td][/tr]
[/table]

Public Function aiRandLong(iMin As Long, _
                           iMax As Long, _
                           Optional ByVal n As Long = -1, _
                           Optional bVolatile As Boolean = False) As Long()
  ' shg 2008
  ' UDF or VBA

  ' Returns a 1-based array of n unique Longs between iMin and iMax inclusive
  ' Requires FY Shuffle

  Dim ai()          As Long     ' array of numbers iMin to iMax
  Dim i             As Long     ' index to ai

  If bVolatile Then Application.Volatile True

  If n < 0 Then n = iMax - iMin + 1
  If iMin > iMax Or n > (iMax - iMin + 1) Or n < 1 Then Exit Function

  ReDim ai(iMin To iMax)

  For i = iMin To iMax
    ai(i) = i
  Next i

  FYShuffle ai
  If n > -1 Then ReDim Preserve ai(iMin To iMin + n - 1)
  aiRandLong = ai
End Function

Sub FYShuffle(av As Variant)
  ' shg 2015
  
  ' In-situ Fisher-Yates shuffle of 1D array av
  ' VBA only

  Dim iLB           As Long
  Dim iTop          As Long
  Dim vTmp          As Variant
  Dim iRnd          As Long

  iLB = LBound(av)
  iTop = UBound(av) - iLB + 1

  Do While iTop
    iRnd = Int(Rnd * iTop)
    iTop = iTop - 1
    vTmp = av(iTop + iLB)
    av(iTop + iLB) = av(iRnd + iLB)
    av(iRnd + iLB) = vTmp
  Loop
End Sub

 

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

Hi Kenneth and thanks for the reply,

The UK lottery has 6 numbers drawn from 59 numbers without replacement. Then there is a further ball drawn (the bonus ball) from the remaining numbers. If the numbers were in sorted order the 7th ball drawn (the bonus ball) will always be of a higher value than the 6th ball, and as we know, this is not the case. I do need them in their physically drawn order so to speak.

The code in post #2 runs 1,000,000 random combinations and outputs them to the Worksheet in around one minute on my poor old laptop.

If I could adapt the code in post #2 to NOT sort them in ascending order that might help things along a bit but I haven’t been able to do that.

******************************************************************************************************
Hi shg and thanks for the reply,

Unfortunately I am at a total loss as to what the code does or what to do with it, sorry.
******************************************************************************************************

Basically, I want it to calculate the matches for each random combination against the set 6 numbered combination as it cycles through and then give me a grand one line total at the end.

Thanks in advance.

 

[shg]

The code just generates random combinations in random order.

 

[B___P]

Hi S.H.A.D.O. happy to read you again.
Give this code a try

Sub skydiver()
Dim x As Long
Dim y As Long
Dim t As Long
Dim rn As Long
Dim CountE As Long
Dim CountXB As Long
Dim x1 As Long
Dim x2 As Long
Dim numbers(1 To 59)
Dim superb(1 To 7)

For x = 1 To 59
    numbers(x) = x
Next x

Range("c7:o7").ClearContents

x = Range("a1").Value
For y = 1 To x
    For t = 1 To 7
        rn = Int(Rnd() * (59 - t + 1) + 1)
        superb(t) = numbers(rn)
        numbers(rn) = numbers(59 - t + 1)
        numbers(59 - t + 1) = superb(t)
    Next t
    CountE = 0
    CountXB = 0
    For x1 = 1 To 6
        For x2 = 1 To 6
            CountE = CountE + IIf(superb(x1) = Cells(4, 2 + x2).Value, 1, 0)
        Next x2
    Next x1

    If superb(7) = Cells(4, 3) Or superb(7) = Cells(4, 4) Or superb(7) = Cells(4, 5) Or _
    superb(7) = Cells(4, 6) Or superb(7) = Cells(4, 7) Or superb(7) = Cells(4, 8) Then CountXB = 1
    
    Select Case CountE
    Case 0
        Cells(7, 3 + CountXB).Value = Cells(7, 3 + CountXB).Value + 1
    Case 1
        Cells(7, 5 + CountXB).Value = Cells(7, 5 + CountXB).Value + 1
    Case 2
        Cells(7, 7 + CountXB).Value = Cells(7, 7 + CountXB).Value + 1
    Case 3
        Cells(7, 9 + CountXB).Value = Cells(7, 9 + CountXB).Value + 1
    Case 4
        Cells(7, 11 + CountXB).Value = Cells(7, 11 + CountXB).Value + 1
    Case 5
        Cells(7, 13 + CountXB).Value = Cells(7, 13 + CountXB).Value + 1
    Case 6
        Cells(7, 15).Value = Cells(7, 15).Value + 1
    End Select
Next y
End Sub

numbers to match in range C4:H4
results in range C7:O7

numbers of random combinations in A1
If you do not want to store random combinations on the sheet I think is not necessary to show partial count of matches so everything runs on only two rows. At the end code is simple

 

[Kenneth Hobson]

Since =COMBIN(59,7)=341,149,446 it will take a lot of memory to hold all possible combinations in memory. In the methods posted, for even say 10,000 sets, I would expect some duplicates.

As for counting, I am not sure that I understand your count matrix. e.g. 0+. There could be a case where none of 6 matched and the bonus does not match. You did not count that.

In any "case" for your counts, name your sets say nums, and use as a UDF array or in a Sub. e.g.

Sub test_nMatches()
  Dim a
  a = nMatches(Range("C4:H4"), Range("nums"))
  MsgBox Join(a, vbLf)
End Sub

'{=nmatches(C4:H4,nums)}
Function nMatches(nM As Range, nD As Range)
  Dim n(1 To 13), i&, j%
  Dim r As Range, rm1 As Range, c As Range
  
  For i = 1 To 13
    n(i) = 0
  Next i
  
  For Each r In nD.Rows
    Set rm1 = r.Resize(, r.Columns.Count - 1)
    i = 0
    j = 0
    For Each c In nM
      If WorksheetFunction.CountIf(rm1, c) = 1 Then i = i + 1
      If WorksheetFunction.CountIf(c, _
      Cells(r.Row, r(1).Column + r.Columns.Count - 1)) = 1 Then _
        j = j + 1
    Next c
    Select Case True
      Case i = 6
        n(13) = n(13) + 1
      Case i = 5
        If j = 0 Then
          n(11) = n(11) + 1
          Else: n(12) = n(12) + 1
        End If
      Case i = 4
        If j = 0 Then
          n(9) = n(9) + 1
          Else
          n(10) = n(10) + 1
        End If
      Case i = 3
        If j = 0 Then
          n(7) = n(7) + 1
          Else
          n(8) = n(8) + 1
        End If
      Case i = 2
        If j = 0 Then
          n(5) = n(5) + 1
          Else
          n(6) = n(6) + 1
        End If
      Case i = 1
        If j = 0 Then
          n(3) = n(3) + 1
          Else
          n(4) = n(4) + 1
        End If
      Case i = 0
        If j = 0 Then n(1) = n(1) + 1
      Case Else
    End Select
  Next r
  
  nMatches = n
End Function

The UDF could be cleaned up a bit using an array loop rather than Select Case.

Using my UDF, you then don't need the helper columns. From here, you can probably figure it out. I would recommend some conditional formats for the cell sets.

 

[B___P]

Hi S.H.A.D.O. give this code a try, it is 25% faster

Sub skydiver2()
Dim x As Long
Dim y As Long
Dim t As Long
Dim rn As Long
Dim CountE As Long
Dim CountXB As Long
Dim x1 As Long
Dim x2 As Long
Dim numbers(1 To 59)
Dim superb(1 To 7)

For x = 1 To 59
    numbers(x) = x
Next x

Range("c7:o7").ClearContents

x = Range("a1").Value
For y = 1 To x
    For t = 1 To 7
        rn = Int(Rnd() * (59 - t + 1) + 1)
        superb(t) = numbers(rn)
        numbers(rn) = numbers(59 - t + 1)
        numbers(59 - t + 1) = superb(t)
        'Cells(12 + y, t).Value = superb(t) 'uncomment this line to show combinations from row 12
    Next t
    CountE = 0
    CountXB = 0
    For x1 = 1 To 6
        For x2 = 1 To 6
            CountE = CountE + IIf(superb(x1) = Cells(4, 2 + x2).Value, 1, 0)
        Next x2
    Next x1

    If superb(7) = Cells(4, 3) Or superb(7) = Cells(4, 4) Or superb(7) = Cells(4, 5) Or _
    superb(7) = Cells(4, 6) Or superb(7) = Cells(4, 7) Or superb(7) = Cells(4, 8) Then CountXB = 1
    
    Cells(7, 3 + CountXB + CountE * 2).Value = Cells(7, 3 + CountXB + CountE * 2).Value + 1
Next y
End Sub

 

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

Hi shg, thanks for the reply and explanation.

Hi Kenneth, thanks for the reply and your thoughts. As far as there being a case where none of the 6 numbers matched AND the bonus number doesn't match B__P's code accommodates that scenario.

Hi B__P, it's nice to talk to you again and thank you for your reply and code, they both work brilliantly and produce the exact results required. I went with the latest code because it was slightly faster.

Thanks to everyone who contributed to my request, it it appreciated.

I am going to have a go at a similar thing that involves 5 numbers being drawn from 39 from one set and 1 number being drawn from 14 from a different set.

Once again, thank you everyone.