[RESOLVED] Pick all numbers from an array in a random sequence

[mikesmith1956]

Hello, I am very new to VB but dabbled a few years back when I wrote a program which simply picked all numbers from 1 to 52 at random and displayed the result in my spreadsheet i.e. the same as dealing a pack of cards.

I have seen complicated solutions here but mine would have been very simple!! Something like - defining the array (1 to 52), telling the program to pick a number, display it in spreadsheet, pick another number from the remainder etc. etc.

It certainly did not have the "remove" method.

Can someone provide a simple program please that includes the method of putting the numbers in the spreadsheet e.g. cells(......).value = x? Many thanks.

[evilsupressor]

the code below is what I believe you are looking for.
if you want to add this to a spreadsheet just copy and past it
it creates a text file with all of your numbers in the folder where you run the application from
just copy this code into a console application

Module Module1
Dim numLst As New List(Of Integer)
Dim rndnum As Integer
    Sub Main()
        For i = 1 To 52
            numLst.Add(i)
        Next
        Dim file As System.IO.StreamWriter
        file = My.Computer.FileSystem.OpenTextFileWriter("c:numList.txt", True)

        For i = 51 To 0 Step -1
            Randomize()
            rndnum = CInt(Int((i + 1) * Rnd()))
            file.WriteLine(numLst.Item(rndnum))
            numLst.Remove(numLst.Item(rndnum))
        Next
        file.Close()
    End Sub

End Module

[Shaggy Hiker]

There's one serious problem with that code. The Randomize() statement re-seeds the random number generator with the system time down to the second. Any random number generator seeded with the same seed will produces the exact same sequence of numbers. So, by calling Randomize in the loop, you pretty much guarantee that the random number generator will produce the same number over and over and over until the system time advances by one second, at which point the random number generator will switch to a new number and write that over and over.

One solution would be to remove the call to Randomize, which should only be called once. However, since this appears to be .NET code, then you should create a single instance of the Random object at form scope, and just use that rather than Randomize and Rnd. After all, the GetNext method of the Random object is more intuitive than the math required for Rnd, and the Randomize call is no longer needed.

The Random object still gets seeded by the system clock, though, so you must be careful to not create a series of Random objects within one second of each other. The safest way to do this is to only ever create one, but sometimes it makes more sense to create one per form, as long as no two forms will be created within one second of each other.

[mikesmith1956]

the code below is what I believe you are looking for.
if you want to add this to a spreadsheet just copy and paste it
it creates a text file with all of your numbers in the folder where you run the application from
just copy this code into a console application

Module Module1
Dim numLst As New List(Of Integer)
Dim rndnum As Integer
Sub Main()
For i = 1 To 52
numLst.Add(i)
Next
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter("c:numList.txt", True)

For i = 51 To 0 Step -1
Randomize()
rndnum = CInt(Int((i + 1) * Rnd()))
file.WriteLine(numLst.Item(rndnum))
numLst.Remove(numLst.Item(rndnum))
Next
file.Close()
End Sub

End Module

Thank you evilsuppressor. I pasted the following into VB in a new excel file within Module 1.

Dim numLst As New List(Of Integer) ***
Dim rndnum As Integer
Sub Main()
For i = 1 To 52
numLst.Add (i)
Next
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter("c:numList.txt", True)

For i = 51 To 0 Step -1
Randomize() ***
rndnum = CInt(Int((i + 1) * Rnd()))
file.WriteLine (numLst.Item(rndnum))
numLst.Remove (numLst.Item(rndnum))
Next
file.Close() ***
End Sub

I got error messages for the lines marked ***

Also, rather than write them to a text file I would like to do something like Cells(i,2).value =rndnum

[mikesmith1956]

Using just numbers 1 to 9 I have found a solution but it is not as neat as the one I am trying to remember. Perhaps it had something related to "Field" ??


Sub picknumber()

Dim i As Integer
Dim rndnum As Integer
For i = 1 To 9
10 rndnum = ((i + 1) * Rnd())
Cells(i, 2).Value = rndnum
If rndnum = 0 Then GoTo 10
If rndnum > 9 Then GoTo 10

'check if number has already been picked
pick = Application.WorksheetFunction.CountIf(Worksheets("Sheet1").Range(Cells(1, 2), Cells(9, 2)), rndnum)
If pick > 1 Then GoTo 10
Next i

End Sub

[mikesmith1956]

oops

should be

Sub picknumber()

Dim i As Integer
Dim rndnum As Integer
For i = 1 To 9
10 rndnum = Int((9 - 1 + 1) * Rnd + 1) 'picks a random between 1 and 9
Cells(i, 2).Value = rndnum

'check if number has already been picked
pick = Application.WorksheetFunction.CountIf(Worksheets("Sheet1").Range(Cells(1, 2), Cells(9, 2)), rndnum)
If pick > 1 Then GoTo 10
Next i

End Sub

So I have solved my problem but not in the way I wanted to! My previous method picked the number from an array and the process "knew" it could not pick the same number. It did not need the "Remove" method that also solves the problem. If anyone knows what I am talking about, could you please tell me!

[incidentals]

a simple way to ensure you get a random set of cards produced is to randomize the cards and then simply draw from the top.

(1) select 2 numbers between 1 and 52 ( assumes array is numbered from 1)
(2) using a temp_store swap the cards using the indices you have just selected first to temp second to first temp to first the classic swap
(3) repeat the above enough times to have shuffled the cards to your satisfaction
(4) draw off the cards from 1 to 52

this can also be done by referencing the cells of the spreadsheet directly ( code available if you get stuck - just ask)

felt in a giving mood today... so here is excel sub (just written. Can give explanation if needed - just pm me)

Sub randomise(r As Range)

'call using randomise [a1:a10]
'where the sheet has data in that range to be randomly arranged

c = r.Cells.Count
x = 3 * c
Randomize
For l = 1 To x
    a = Int(Rnd() * c) + 1
    b = Int(Rnd() * c) + 1
    temp = [r](a)
    [r](a) = [r](b)
    [r](b) = temp
Next
End Sub

a macro of the above - as it takes no arguments - but needs a named region - so some maintenance headaches!

Sub random()

'call using named region "cards"
'where the sheet has data in that range to be randomly arranged

c = Range("cards").Cells.Count
x = 3 * c
Randomize

For l = 1 To x

    a = Int(Rnd() * c) + 1
    b = Int(Rnd() * c) + 1
 
    temp = Range("cards")(a)
    Range("cards")(a) = Range("cards")(b)
    Range("cards")(b) = temp
    
Next
End Sub

for completeness i have added a version that can be used with a selection and reduced the routine a bit

Sub short_randomise()
'shortened to use only 1 random call
'call using randomise
'where a selection has been made on a sheet containing starting values

 Randomize
 For Each cell In Selection
    x = Int(Rnd() * Selection.Count) + 1
    temp = cell(1)
    cell(1) = Selection(x)
    Selection(x) = temp
 Next
End Sub

it does not matter that the process swaps a card with itself or several card pairs back and forth it is all random!

please try it and see how much easier it is than checking for "sameness" and reworking

less lines of code less checking and produces randomness like proper shuffling

here to help

and please remember to close the thread when you've done and if possible show the final code you used and rate those who have helped!

[mikesmith1956]

Thanks incidentals. I will take a look at this and give it a try.

[incidentals]

you can build a macro to initially fill the region with data...

the region can be a rectangular region anywhere on the sheet.

[dday9]

You want an randomly ordered array populated with values from 1 - 52. The smallest solution would be to generate a range of numbers from 1 - 52, use OrderBy, and pass a Random object's Next value:

'r = New Random()
Dim cards = Enumerable.Range(1, 52).OrderBy(Function(c) r.Next())

Fiddle: https://dotnetfiddle.net/hpMbkG

Edit: I just realized that this is for VBA and not VB.NET so my code is worthless to you, but the concept is still the same.

[mikesmith1956]

You want an randomly ordered array populated with values from 1 - 52. The smallest solution would be to generate a range of numbers from 1 - 52, use OrderBy, and pass a Random object's Next value:

'r = New Random()
Dim cards = Enumerable.Range(1, 52).OrderBy(Function(c) r.Next())

Fiddle: https://dotnetfiddle.net/hpMbkG

Edit: I just realized that this is for VBA and not VB.NET so my code is worthless to you, but the concept is still the same.

Thanks Dday. I am, in fact, using VBA so perfect. I will give it a try.

[mikesmith1956]

Dday, I copied and pasted your code into VBA and the red lines (see attached link) produced errors. Could you give me the code which would put the individual numbers into a spreadsheet please? - presumably something like ........cells(x,y).value = r Next x........ many thanks. http://prntscr.com/aoubj2

[dday9]

Right, I pointed out in my edit that my code is for Visual Basic .NET and not Visual Basic for Applications. You cannot copy/paste my code into a VBA module.

[incidentals]

'

r = New Random()
Dim cards = Enumerable.Range(1, 52).OrderBy(Function(c) r.Next())

out of interest does this code generate an enumeration containing just 1 of each number in a random order or does it have 52 possibly non unique numbers chosen at random?

here to learn

[dday9]

'

r = New Random()
Dim cards = Enumerable.Range(1, 52).OrderBy(Function(c) r.Next())

out of interest does this code generate an enumeration containing just 1 of each number in a random order or does it have 52 possibly non unique numbers chosen at random?

here to learn

This will produce an IEnumerable(Of Integer) with numbers 1 - 52 randomly ordered. There is an example fiddle that you can test the code in post #10.

[passel]

...
Sub picknumber()

Dim i As Integer
Dim rndnum As Integer
For i = 1 To 9
10 rndnum = Int((9 - 1 + 1) * Rnd + 1) 'picks a random between 1 and 9
Cells(i, 2).Value = rndnum

'check if number has already been picked
pick = Application.WorksheetFunction.CountIf(Worksheets("Sheet1").Range(Cells(1, 2), Cells(9, 2)), rndnum)
If pick > 1 Then GoTo 10
Next i

End Sub

So I have solved my problem but not in the way I wanted to! My previous method picked the number from an array and the process "knew" it could not pick the same number. It did not need the "Remove" method that also solves the problem. If anyone knows what I am talking about, could you please tell me!

It may not have had a Remove, but it did probably have a swap.
The way I've always done it is create an array and set the numbers in it (say an array (Deck) 0 to 51, with the numbers 1 to 52).
You have a variable (CardsInDeck) set to 52 which is the number of cards in the deck.
You choose a random card (cardIdx) from the deck. cardIdx = int(Rnd * CardsInDeck)
You decrement the number of cards in the deck. CardsInDeck = CardsInDeck - 1
You swap the card chosen (cardIdx) with the top available card (CardsInDeck), so that you can't choose that card again.
card = Deck(cardIdx)
Deck(cardIdx) = Deck(CardsInDeck)
Deck(CardsInDeck) = card
You return card as the card selected.

'pseudo code, not tested or written in the VB IDE

'Assumes you've initialized Deck(0 to 51) with the numbers 1 to 52

Function PickACard() As Integer
  Static CardsInDeck as Integer
  Dim cardIdx as Integer
  Dim card as Integer

  If CardsInDeck <= 0 Then
    CardsInDeck = 52  'start dealing from a "new deck"
  End If
  cardIdx = Int(Rnd * CardsInDeck)
  CardsInDeck = CardsInDeck - 1
  card = Deck(cardIdx)
  Deck(cardIdx) = Deck(CardsInDeck)
  Deck(CardsInDeck) = card
  PickACard = card
End Function

[incidentals]

thats short of true randomness as you can always swap a pair serveral times and leave whole sections sequential in a true randomness

[passel]

thats short of true randomness as you can always swap a pair serveral times and leave whole sections sequential in a true randomness

No, that is not the case. The analog is picking cards at random from the deck. The deck could be in a bag, a hat, whatever.
If I give you a deck of cards and ask you to pull one card out at random and put it on the table, you can't ever pull that card from the deck again.
If you continue doing so, then you will end up with a stack of cards on the table in some random order.
If you happen to choose adjacent cards randomly, then you could end up with a series of cards in order in either case.

While I happened to "invent" this myself 30 some years ago (didn't seem like much of an invention, but an obvious analog to choosing a card at random from the deck, then putting it at the end of the array so you wouldn't choose it again), the fact is it was already "invented" and documented more than once (see Fisher-Yates shuffle and also Knuth shuffle).
I'm not a mathematician, so wouldn't even try to justify the shuffle. But randomly pulling objects from a bag just seemed like an obvious way to implement the need to draw cards from a deck in the first card game I wrote.
The Wiki article linked to above says "The algorithm produces an unbiased permutation: every permutation is equally likely." Who knew?

[incidentals]

i am sorry but ...

are you sure this algorithm produces a complete reordering of all 52 cards

i do not see how a previously picked casr is removed from the "pack"/"bag"

here to understand

obviously a bit thick this morning ... no delete just put beyond end of deck

i do not see the dimensioning of the array and that i THINK WAS THROWING ME

HERE WITH A LITTLE MORE UNDERSTANDING

sorry about caps

[Schmidt]

I'm a bit late - though wanted to mention that the method DDay has shown,
is of course also available with "normal SQL" (not only per LINQ).

So, in case the OP has e.g. a "JET-mdb" already available in his App-scenario, all the
Card-Definitions could be stored (normally ordered) in a "Deck"-Table for example
(e.g. with two fields - a CardID - and "friendly CardNames" like "Ace of Spades" or something.

The Select which will then "derive" a "Shuffled Deck"-Recordset (from the ordered Deck-DB-Table),
would be as simple as:
"Select * From Deck Order By Rnd(CardId)"
(in JET-SQL lingo).

Here's a simple example (VB6-code, pastable into an empty Form):

Option Explicit
 
Private Cnn As Object, DBName, i

Private Sub Form_Load()
  DBName = Environ("temp") & "\test1.mdb"
  If CreateObject("Scripting.FileSystemObject").FileExists(DBName) Then Kill DBName
 
  Set Cnn = CreateObject("ADOX.Catalog").Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBName)
      
  Cnn.Execute "Create Table Deck(CardId Long)"
  For i = 1 To 6
    Cnn.Execute "Insert Into  Deck Values(" & i & ")"
  Next
End Sub

Private Sub Form_Click()
  With Cnn.Execute("Select * From Deck Order By Rnd(CardId)")
    Do Until .EOF: Debug.Print !CardId;: .MoveNext: Loop: Debug.Print
  End With
End Sub

Producing for the simple Deck with only 6 Cards (in the immediate Window,
after clicking the Form 4 times):

 4  5  2  3  1  6 
 1  5  6  4  2  3 
 6  3  2  1  5  4 
 5  2  3  6  4  1

Here another (less cluttered) example, when an SQLite-InMemory-DB is used instead
(producing similarly shuffled Debug-output, when clicking the form repeatedly):

Option Explicit

Private MemDB As New cMemDB, i

Private Sub Form_Load()
  MemDB.Exec "Create Table Deck(CardId Long)"
  For i = 1 To 6
    MemDB.ExecCmd "Insert Into Deck Values(?)", i
  Next
End Sub

Private Sub Form_Click()
  With MemDB.GetTable("Deck", , "Random()")
    Do Until .EOF: Debug.Print !CardId;: .MoveNext: Loop: Debug.Print
  End With
End Sub

Olaf

[mikesmith1956]

Thanks to everyone contributing. I feel I ought to close the thread as it has run its course. One last observation re the code I was trying to remember, I found some of my workings and they included defining the array as boolean. If I assign '1' to a random place in the array, it appears to give TRUE to that component. (Sorry I am probably using wrong terminology). If I then try to assign '2' to a random place and the program happens to chose the same component, I could test whether it was already TRUE and tell the program to chose again. I just don't remember having to program the test as to whether it was already TRUE. Rather, the program knew it had to pick another random place. Hope that makes sense to someone - remember I am using VBA within an excel file.

[passel]

Well, earlier versions of Microsoft Basic didn't have a Boolean type, so you had to use an Integer.
Then even when they added the type, Boolean, it was still using the integer as the holder for the type (and could be treated as an Integer for the most part).

So, 0 = False, and any other number would be interpreted as True.
So, you could do something along the lines of
(off the top of my head, not tested)(assuming an array(0 to 9) to hold the values 1 to 10 in randomly selected) order.

P = rnd*10

For I = 1 to 10
  while ary(p) : p = rnd*10: wend
  ary(p) = i
Next

Not very efficient though since it has to keep picking slots until it finds an empty one.

p.s. Might even be able to do that in one line (of four statements), but I'm not sure without trying it. Don't usually do silly things like this.
while ary(p) : p = rnd*10: wend: ary(p) = i

[mikesmith1956]

I am closing the thread now. So many thanks for all your help.