Select a random number from a list then remove, rinse, repeat

tezza

tezza

Active Member
Joined
Sep 10, 2006
Messages
375
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
  2. Web
Hi all,

Ok, I'll try to explain what I need.

I have a number list 1 - 90

The numbers are split in 9 groups

I need to randomly pick 5 groups then randomly pick 1 number from each of the groups,
Show the numbers picked
remove the picked numbers from the original list

After the first round of picks the list of numbers reduce by five

With the remaining numbers I need to repeat the process - choose 5 random numbers from 5 random groups and remove from list

Rinse and repeat until there are no numbers left

When all the numbers in a group have been used then that group needs to be eliminated.

Bingo.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCR
1Random No:GroupGroupGroupGroupGroupGroupGroupGroupGroup
212345123456789
311344068711234567910121314151617181920222324252627282930313233353637384142434446474950515253545658596061636465666769707273747576777879818283848687888990
48214855801234567910121314151617181920222324252627282930313233353637384142434446474950515253545658596061636465666769707273747576777879818283848687888990
539455762851234567910121314151617181920222324252627282930313233353637384142434446474950515253545658596061636465666769707273747576777879818283848687888990
Sheet1
 
Sort by date Sort by votes
I don't understand your last example at all. Why do some rows in the right grid only have 3 or 4 numbers? I thought 5 were to be chosen each time?
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Because it's showing ALMOST complete, there's 5 numbers left to pick in the left grid so 2 will go in the 3 count and 1 each in the 4 count to complete the 5 count all the way down.

It was just my way to show and example of what should be left with one final pick to go.

Didn't mean to confuse you.
 
Upvote 0
Here's the complete list:

numbers 4.png
 
Upvote 0
Working code for the first example:
VBA Code: 
Dim ranColumns(4) As Integer
Sub test()
  Dim ranGroups(4) As Integer
  Dim ranGroup As Integer, rand As Integer, i As Integer
  Dim inGroup As Boolean

  rand = 0
  Do While rand <= 4
    inGroup = False
    ranGroup = Int((9 - 1 + 1) * Rnd + 1)
    For Each rndGroup In ranGroups
      If rndGroup = ranGroup Then
        inGroup = True
      End If
    Next
    If Not inGroup Then
      ranGroups(rand) = ranGroup
      rand = rand + 1
    End If
  Loop
  For i = LBound(ranGroups) To UBound(ranGroups)
    For j = i + 1 To UBound(ranGroups)
      If ranGroups(i) > ranGroups(j) Then
        ranGroup = ranGroups(j)
        ranGroups(j) = ranGroups(i)
        ranGroups(i) = ranGroup
      End If
    Next j
  Next i
  For r = 3 To 5 'Number of rows you want to write
  i = 0
    For Each rndGroup In ranGroups
      Select Case rndGroup
        Case 1
          Call pickRandNumber(7, 15, i)
        Case 9
          Call pickRandNumber(86, 96, i)
        Case Else
          Call pickRandNumber((rndGroup * 10) - 4, (rndGroup * 10) + 5, i)
      End Select
      i = i + 1
    Next
    For c = 1 To 5
      Cells(r, c).Value = Cells(r, ranColumns(c - 1)).Value
      Range(Cells(3, ranColumns(c - 1)), Cells(5, ranColumns(c - 1))).ClearContents
    Next
  Next
End Sub
Sub pickRandNumber(c1 As Integer, c2 As Integer, i As Integer)
  Dim ranColumn As Integer
  ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Do While Cells(3, ranColumn).Value = ""
    ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Loop
  ranColumns(i) = ranColumn
End Sub
 
Upvote 0
Flashbond said:
Working code for the first example:
VBA Code: 
Dim ranColumns(4) As Integer
Sub test()
  Dim ranGroups(4) As Integer
  Dim ranGroup As Integer, rand As Integer, i As Integer
  Dim inGroup As Boolean

  rand = 0
  Do While rand <= 4
    inGroup = False
    ranGroup = Int((9 - 1 + 1) * Rnd + 1)
    For Each rndGroup In ranGroups
      If rndGroup = ranGroup Then
        inGroup = True
      End If
    Next
    If Not inGroup Then
      ranGroups(rand) = ranGroup
      rand = rand + 1
    End If
  Loop
  For i = LBound(ranGroups) To UBound(ranGroups)
    For j = i + 1 To UBound(ranGroups)
      If ranGroups(i) > ranGroups(j) Then
        ranGroup = ranGroups(j)
        ranGroups(j) = ranGroups(i)
        ranGroups(i) = ranGroup
      End If
    Next j
  Next i
  For r = 3 To 5 'Number of rows you want to write
  i = 0
    For Each rndGroup In ranGroups
      Select Case rndGroup
        Case 1
          Call pickRandNumber(7, 15, i)
        Case 9
          Call pickRandNumber(86, 96, i)
        Case Else
          Call pickRandNumber((rndGroup * 10) - 4, (rndGroup * 10) + 5, i)
      End Select
      i = i + 1
    Next
    For c = 1 To 5
      Cells(r, c).Value = Cells(r, ranColumns(c - 1)).Value
      Range(Cells(3, ranColumns(c - 1)), Cells(5, ranColumns(c - 1))).ClearContents
    Next
  Next
End Sub
Sub pickRandNumber(c1 As Integer, c2 As Integer, i As Integer)
  Dim ranColumn As Integer
  ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Do While Cells(3, ranColumn).Value = ""
    ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Loop
  ranColumns(i) = ranColumn
End Sub
Click to expand...
Hi

Do I insert this into a module or into the sheet?

I've placed it in module and it's just got the timer symbol going after 5 mins. Any ideas?
 
Upvote 0
Flashbond said:
Working code for the first example:
Click to expand...
Is it? How long did it take to run? After several minutes I gave up waiting. Looks like tezza had the same problem. Likely related to the issue outlined below.

tezza said:
Here's the complete list:
Click to expand...
I'm not convinced that you chose the groups and/or numbers for each group at random.

Here is an example that I did
Starting with all 90 numbers in row 14
- In row 15 I used a random number generator to look to see which groups still had numbers (all 9 groups of course). The groups chosen were 2,8,4,1,7 as shown in cell E15. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in cell F15. I removed those numbers in the range G15:CR15
- In row 16 I used a random number generator to look to see which groups still had numbers (all 9 groups still at this stage). The groups chosen are shown in E16. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in F16. I removed those numbers in the range G16:CR16
- The above process was continued with random groups chosen shown in column E and random available numbers from those groups shown in column F. The chosen numbers removed in cols G:CR

Because random numbers do not necessarily spread themselves exactly evenly (eg tossing a coin 6 times does not necessarily result in 3 heads and 3 tails) you can see in this case that after 15 turns 5 groups have been exhausted of their numbers meaning that my random number generator trying to choose 5 groups with remaining numbers could not do that.

tezza.xlsm
DEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCR
12GroupGroupGroupGroupGroupGroupGroupGroupGroup
13123456789
14Turn5 random GroupsRand no. from each group123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990
1512,8,4,1,714,77,34,6,69123457891011121315161718192021222324252627282930313233353637383940414243444546474849505152535455565758596061626364656667687071727374757678798081828384858687888990
1629,2,5,4,881,11,43,37,7212345789101213151617181920212223242526272829303132333536383940414244454647484950515253545556575859606162636465666768707173747576787980828384858687888990
1731,7,4,9,22,62,36,90,1813457891012131516171920212223242526272829303132333538394041424445464748495051525354555657585960616364656667687071737475767879808283848586878889
1843,8,4,6,525,79,31,57,401345789101213151617192021222324262728293032333538394142444546474849505152535455565859606163646566676870717374757678808283848586878889
1958,1,9,5,473,1,86,47,333457891012131516171920212223242627282930323538394142444546484950515253545556585960616364656667687071747576788082838485878889
2064,8,9,7,238,75,83,60,19345789101213151617202122232426272829303235394142444546484950515253545556585961636465666768707174767880828485878889
2173,9,4,2,521,88,35,13,4834578910121516172022232426272829303239414244454649505152535455565859616364656667687071747678808284858789
2289,7,8,2,489,65,70,10,323457891215161720222324262728293039414244454649505152535455565859616364666768717476788082848587
2395,7,2,4,845,67,16,39,76345789121517202223242627282930414244464950515253545556585961636466687174788082848587
24108,4,9,7,278,30,84,64,1234578915172022232426272829414244464950515253545556585961636668717480828587
25116,9,2,7,152,80,17,66,435789152022232426272829414244464950515354555658596163687174828587
26127,6,3,9,563,56,27,85,423578915202223242628294144464950515354555859616871748287
27132,5,7,8,915,49,68,74,82357892022232426282941444650515354555859617187
28143,8,1,5,923,71,5,41,87378920222426282944465051535455585961
29157,1,5,3,661,9,46,26,51378202224282944505354555859
90
 
Upvote 0
I see your point. Since I have no control in Rnd function I will consider the numbers are spread "evenly".
Also another .Value <> "" statement must be added for each column while picking group numbers since there might be no number left to pick. Which will make the process even longer...
 
Upvote 0
Peter_SSs said:
Is it? How long did it take to run? After several minutes I gave up waiting. Looks like tezza had the same problem. Likely related to the issue outlined below.


I'm not convinced that you chose the groups and/or numbers for each group at random.

Here is an example that I did
Starting with all 90 numbers in row 14
- In row 15 I used a random number generator to look to see which groups still had numbers (all 9 groups of course). The groups chosen were 2,8,4,1,7 as shown in cell E15. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in cell F15. I removed those numbers in the range G15:CR15
- In row 16 I used a random number generator to look to see which groups still had numbers (all 9 groups still at this stage). The groups chosen are shown in E16. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in F16. I removed those numbers in the range G16:CR16
- The above process was continued with random groups chosen shown in column E and random available numbers from those groups shown in column F. The chosen numbers removed in cols G:CR

Because random numbers do not necessarily spread themselves exactly evenly (eg tossing a coin 6 times does not necessarily result in 3 heads and 3 tails) you can see in this case that after 15 turns 5 groups have been exhausted of their numbers meaning that my random number generator trying to choose 5 groups with remaining numbers could not do that.

tezza.xlsm
DEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCR
12GroupGroupGroupGroupGroupGroupGroupGroupGroup
13123456789
14Turn5 random GroupsRand no. from each group123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990
1512,8,4,1,714,77,34,6,69123457891011121315161718192021222324252627282930313233353637383940414243444546474849505152535455565758596061626364656667687071727374757678798081828384858687888990
1629,2,5,4,881,11,43,37,7212345789101213151617181920212223242526272829303132333536383940414244454647484950515253545556575859606162636465666768707173747576787980828384858687888990
1731,7,4,9,22,62,36,90,1813457891012131516171920212223242526272829303132333538394041424445464748495051525354555657585960616364656667687071737475767879808283848586878889
1843,8,4,6,525,79,31,57,401345789101213151617192021222324262728293032333538394142444546474849505152535455565859606163646566676870717374757678808283848586878889
1958,1,9,5,473,1,86,47,333457891012131516171920212223242627282930323538394142444546484950515253545556585960616364656667687071747576788082838485878889
2064,8,9,7,238,75,83,60,19345789101213151617202122232426272829303235394142444546484950515253545556585961636465666768707174767880828485878889
2173,9,4,2,521,88,35,13,4834578910121516172022232426272829303239414244454649505152535455565859616364656667687071747678808284858789
2289,7,8,2,489,65,70,10,323457891215161720222324262728293039414244454649505152535455565859616364666768717476788082848587
2395,7,2,4,845,67,16,39,76345789121517202223242627282930414244464950515253545556585961636466687174788082848587
24108,4,9,7,278,30,84,64,1234578915172022232426272829414244464950515253545556585961636668717480828587
25116,9,2,7,152,80,17,66,435789152022232426272829414244464950515354555658596163687174828587
26127,6,3,9,563,56,27,85,423578915202223242628294144464950515354555859616871748287
27132,5,7,8,915,49,68,74,82357892022232426282941444650515354555859617187
28143,8,1,5,923,71,5,41,87378920222426282944465051535455585961
29157,1,5,3,661,9,46,26,51378202224282944505354555859
90
Click to expand...
Hmmmmmmmm

My example was a visual random pick, I just looked for the lowest count then randomly put a number in somewhere. Is that something you could factor in?

You have done what I asked to be fair, so, I'm now open to suggestions.

How did you create the random generators in Cols E & F?
 
Upvote 0
tezza said:
How did you create the random generators in Cols E & F?
Click to expand...
There was a fair bit of manual input to give the random number generator the values to choose from so it would be no use to you in trying to automate this process.

tezza said:
so, I'm now open to suggestions.
Click to expand...
Suggestions for what? To make the randomness not random?
 
Upvote 0
Peter, is everything ok?

Your interactions through this post have been irregularly negative, and almost implying I'm thick or something.

Suggestions for what? To make the randomness not random?
Click to expand...
No, to make my original query work, which I thought would have been self evident. If I'd have explained that then I would have sounded condescending.


There was a fair bit of manual input to give the random number generator the values to choose from so it would be no use to you in trying to automate this process.
Click to expand...
That probably explains why all the 4's came out one after the other, the actual chances of that is higher than winning the lottery, but don't worry, I get your point - EXACTLY

b. It mostly won't work anyway.
Click to expand...
Not to worry, in the background the answer silently came, without any negativity:

VBA Code: 
Sub Generate_New_Numbers()
Dim Result(1 To 162) As Variant
Dim Output(1 To 18, 1 To 9) As Variant
Dim AR(1 To 90) As Integer:     fillNums AR
Dim Patterns As Object:         setPatterns Patterns
Dim Six As Object:              setSix Six
Dim Grid As Object:             setGrid Grid
Dim Queue As Object

Shuffle AR
fillQueue Queue, AR
fillArray Result, Queue, Patterns, Six, Grid
fillOutput Result, Output
Range("A1").Resize(UBound(Output, 1), UBound(Output, 2)).Value2 = Output
End Sub

Sub setGrid(ByRef Grid As Object)
Set Grid = CreateObject("System.Collections.ArrayList")
Dim lo As Object, hi As Object, tmp As Object

For i = 0 To 5
    Set tmp = CreateObject("System.Collections.ArrayList")
    Set lo = CreateObject("System.Collections.ArrayList")
    Set hi = CreateObject("System.Collections.ArrayList")
    Select Case i
        Case 0
            lo.Add 2
            lo.Add 2
            lo.Add 1
            hi.Add 3
            hi.Add 3
            hi.Add 3
            hi.Add 5
            hi.Add 5
            hi.Add 4
        Case 1
            lo.Add 2
            lo.Add 1
            lo.Add 0
            hi.Add 5
            hi.Add 4
            hi.Add 3
            hi.Add 4
            hi.Add 3
            hi.Add 5
        Case 2
            lo.Add 0
            lo.Add 1
            lo.Add 2
            hi.Add 3
            hi.Add 5
            hi.Add 3
            hi.Add 4
            hi.Add 5
            hi.Add 4
        Case 3
            lo.Add 2
            lo.Add 2
            lo.Add 0
            hi.Add 4
            hi.Add 3
            hi.Add 4
            hi.Add 5
            hi.Add 3
            hi.Add 3
        Case 4
            lo.Add 1
            lo.Add 1
            lo.Add 2
            hi.Add 3
            hi.Add 3
            hi.Add 4
            hi.Add 5
            hi.Add 5
            hi.Add 5
        Case 5
            lo.Add 0
            lo.Add 2
            lo.Add 2
            hi.Add 4
            hi.Add 4
            hi.Add 5
            hi.Add 3
            hi.Add 3
            hi.Add 3
    End Select
tmp.Add lo
tmp.Add hi
Grid.Add tmp
Next i

End Sub

Sub setSix(ByRef Six As Object)
Set Six = CreateObject("System.Collections.ArrayList")

Six.Add Array(1, 0, 0)
Six.Add Array(0, 1, 0)
Six.Add Array(0, 0, 1)
Six.Add Array(1, 1, 0)
Six.Add Array(0, 1, 1)
Six.Add Array(1, 0, 1)
End Sub

Sub setPatterns(ByRef Patterns As Object)
Set Patterns = CreateObject("System.Collections.ArrayList")

Patterns.Add Array(2, 2, 1, 2, 1, 1)
Patterns.Add Array(1, 2, 2, 1, 2, 2)
Patterns.Add Array(2, 1, 2, 2, 2, 1)
Patterns.Add Array(2, 2, 2, 1, 1, 2)
Patterns.Add Array(2, 1, 1, 2, 2, 2)
Patterns.Add Array(1, 2, 2, 2, 2, 1)
Patterns.Add Array(2, 2, 2, 1, 1, 2)
Patterns.Add Array(2, 1, 1, 2, 2, 2)
Patterns.Add Array(1, 2, 2, 2, 2, 2)

End Sub

Function getRnd(hi As Variant, lo As Variant) As Integer
getRnd = Int(((hi + 1) - lo) * Rnd() + lo)
End Function

Sub fillQueue(ByRef Queue As Object, ByRef AR() As Integer)
Set Queue = CreateObject("System.Collections.Queue")
For i = 1 To UBound(AR)
    Queue.enqueue AR(i)
Next i
End Sub

Sub fillNums(ByRef AR() As Integer)
For i = 1 To 90: AR(i) = i: Next i
End Sub

Sub Shuffle(ByRef AR() As Integer)
Randomize
Dim Group As Integer, swap As Integer, tmp As Integer, gs As Integer

gs = 9

For i = 1 To UBound(AR) - 1
    If i = 10 Then gs = gs + 1
    If i < 10 Then
        Group = Int((i - 1) / gs) * gs
        swap = getRnd(Group + gs, Group + 1)
    ElseIf i < UBound(AR) - 10 Then
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 10)
    Else
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 11)
    End If
   
    tmp = AR(i)
    AR(i) = AR(swap)
    AR(swap) = tmp
Next i
End Sub

Sub fillArray(ByRef Result() As Variant, Queue As Object, Patterns As Object, Six As Object, Grid As Object)
Dim RN As Integer: RN = 0
Dim RP As Integer: RP = 0
Dim Pos As Integer: Pos = 1
Dim tmp As Variant
Dim Pat As Variant

For i = 1 To 9
    tmp = Patterns(i - 1)
    For j = 0 To UBound(tmp)
        If tmp(j) = 1 Then
            RP = getRnd(Grid(j)(0).Count - 1, 0)
            Pat = Six(Grid(j)(0)(RP))
            Grid(j)(0).removeAt RP
        Else
            RP = getRnd(Grid(j)(1).Count - 1, 0)
            Pat = Six(Grid(j)(1)(RP))
            Grid(j)(1).removeAt RP
        End If
        For k = LBound(Pat) To UBound(Pat)
            If Pat(k) = 1 Then
                Result(Pos) = Queue.dequeue()
            Else
                Result(Pos) = vbNullString
            End If
            Pos = Pos + 1
        Next k
    Next j
Next i
End Sub

Sub ShuffleOnesTwos(ByRef Pat As Variant)
Dim Pos As Integer, tmp As Integer

For i = LBound(Pat) To UBound(Pat)
    Pos = getRnd(UBound(Pat), 0)
    tmp = Pat(i)
    Pat(i) = Pat(Pos)
    Pat(Pos) = tmp
Next i
End Sub

Sub fillOutput(ByRef Result() As Variant, ByRef Output As Variant)
Dim Col As Integer: Col = 1
Dim Pos As Integer: Pos = 1
For i = LBound(Result) To UBound(Result)
    Output(Pos, Col) = Result(i)
    Pos = Pos + 1
    If i Mod 18 = 0 Then
        Col = Col + 1
        Pos = 1
    End If
Next i
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
How to get random generator to pick from a list but delete the item it has picked
2
Replies
17
Views
553
Peter_SSs
Peter_SSs
I
  • Solved
Generate list of players for four school teams
2
Replies
16
Views
265
imcl75
I
M
  • Solved
Changing the position of a message box
Replies
1
Views
292
6StringJazzer
6StringJazzer
M
  • Solved
'Weighted' random name picker
Replies
8
Views
974
DanteAmor
DanteAmor
K
  • Question
Return a user specified number of cell values to a comma list randomly
Replies
1
Views
75
Eric W
Eric W

Forum statistics

Threads
1,214,983
Messages
6,122,592
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top