I want to simulate dealing a pack of cards. So i want to generate a nunber
between 1 and 52, then on the next run, generate another number but
without
the number just found. Then the next hand again a number between 1 and 52
but
minus the numbers found and so on. Anyone out there?
Below is a routine I developed quite awhile ago for the compiled VB world,
but the code works fine in Excel's VBA. Two methods are provided... the
first method answer the question you asked but, given you want to generate
cards, you may the second method more to your liking.
Rick
FIRST METHOD
=================
The following is a generalized "shuffling" routine. Give it an array of
elements and it will put them in random order and return the randomized
elements back in the original array that was passed to it. It only visits
*each* array element *once* so it is quick. The code takes care of running
the Randomize statement one time only (which is all that is necessary).
Sub RandomizeArray(ArrayIn As Variant)
Dim X As Long
Dim RandomIndex As Long
Dim TempElement As Variant
Static RanBefore As Boolean
If Not RanBefore Then
RanBefore = True
Randomize
End If
If VarType(ArrayIn) >= vbArray Then
For X = UBound(ArrayIn) To LBound(ArrayIn) Step -1
RandomIndex = Int((X - LBound(ArrayIn) + 1) * _
Rnd + LBound(ArrayIn))
TempElement = ArrayIn(RandomIndex)
ArrayIn(RandomIndex) = ArrayIn(X)
ArrayIn(X) = TempElement
Next
Else
'The passed argument was not an array
'Put error handler here, such as . . .
Beep
End If
End Sub
The passed array may be of any normal type -- integer, string, single, etc.
The neat thing is, if you pass an already randomized array to this routine,
those randomly ordered elements will be randomize -- sort of like shuffling
an already shuffled deck of cards. In your case, simply set up the array
something like this
Dim DeckOfCards(1 To 52) As Long
For X = 1 To 52
DeckOfCards(X) = X
Next
and to shuffle (randomize) it, simply call
RandomizeArray DeckOfCards
Each array element will now hold a unique, random number from 1 through 52
for the above example.
SECOND METHOD
=================
Here is another take on the same routine which actually returns "named"
cards such as 3 of Hearts (here your DeckOfCards is declared as a String:
Sub ShuffleDeck(Deck() As String)
Dim X As Integer
Dim TempInt As Integer
Dim TempCard As String
Static TempDeck(1 To 52) As String
Static RanBefore As Boolean
If Not RanBefore Then
RanBefore = True
Randomize
If UBound(Deck) <> 52 Then
'Programmer passed an improper array
MsgBox "Deck array is dimensioned incorrectly"
Exit Sub
ElseIf TempDeck(52) = "" Then
'Initialize the deck of cards
For X = 1 To 52
If ((X - 1) Mod 13) = 0 Then
TempDeck(X) = "Ace"
ElseIf ((X - 1) Mod 13) = 10 Then
TempDeck(X) = "Jack"
ElseIf ((X - 1) Mod 13) = 11 Then
TempDeck(X) = "Queen"
ElseIf ((X - 1) Mod 13) = 12 Then
TempDeck(X) = "King"
Else
TempDeck(X) = CStr(1 + ((X - 1) Mod 13))
End If
TempDeck(X) = TempDeck(X) & " of "
If (X - 1) \ 13 = 0 Then
TempDeck(X) = TempDeck(X) & "Spades"
ElseIf (X - 1) \ 13 = 1 Then
TempDeck(X) = TempDeck(X) & "Hearts"
ElseIf (X - 1) \ 13 = 2 Then
TempDeck(X) = TempDeck(X) & "Diamonds"
ElseIf (X - 1) \ 13 = 3 Then
TempDeck(X) = TempDeck(X) & "Clubs"
End If
Next
End If
End If
'Let us shuffle the deck
X = 52
For X = 52 To 1 Step -1
TempInt = Int(X * Rnd + 1)
Deck(X) = TempDeck(TempInt)
TempCard = TempDeck(X)
TempDeck(X) = TempDeck(TempInt)
TempDeck(TempInt) = TempCard
Next
End Sub
Everything is self-contained in this version; just pass it an array
dimensioned between 1 and 52 as in this example use:
Private Sub CommandButton1_Click()
Dim MyDeck(1 To 52) As String
ShuffleDeck MyDeck
Debug.Print MyDeck(1) & ", " & MyDeck(4) & ", " & MyDeck(43)
End Sub
