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?

Hello,

I suggest to use my UDF UniqRandInt:
http://www.sulprobil.com/html/uniqrandint.html

You can also use it if you want to simulate two card decks (104 cards
showing the numbers 1 to 52 twice) which are used most often in
reality.

Regards,
Bernd

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

"Rick Rothstein (MVP - VB)" wrote in
message ...
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

Rick, that's pretty slick. I'll bet you could make it even slicker by
modifying this portion:

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"


So that instead of returning the string name Spades, Hearts, Diamonds,
Clubs, it returns the red or black colored symbol.

Biff

Rick, that's pretty slick.

Thanks!

I'll bet you could make it even slicker by modifying this portion:

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"

So that instead of returning the string name Spades, Hearts,
Diamonds, Clubs, it returns the red or black colored symbol.

That might be somewhat difficult to do... not the coding, that is easy...
rather, where to display it at. The card suit symbols exist in the Symbol
font, as do the ten digits, but the letters (AJQK) do not. I am newly
returned to Excel after a long absence, so I may have forgotten... it there
a display object in the VBA world that can take mixed fonts like the Form or
PictureBox objects in the compiled versions of VB?

Rick

I'll bet you could make it even slicker by modifying this portion:

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"

So that instead of returning the string name Spades, Hearts,
Diamonds, Clubs, it returns the red or black colored symbol.

That might be somewhat difficult to do... not the coding, that is easy...
rather, where to display it at. The card suit symbols exist in the Symbol
font, as do the ten digits, but the letters (AJQK) do not. I am newly
returned to Excel after a long absence, so I may have forgotten... it
there a display object in the VBA world that can take mixed fonts like the
Form or PictureBox objects in the compiled versions of VB?

Okay, this is not a "smooth" solution (because it requires specialized
coding rather than general purpose procedures), but it sure looks neat (and
will give an idea of what is possible). Add a UserForm to the project. Right
click the Toolbox and select Additional Controls from the popup menu. Select
a Microsoft Rich Textbox Control 6.0 from the list and click OK. Now add a
reasonably tall RichTextBox control to the UserForm along with a
CommandButton. Paste the code below into the UserForm's code window, run the
project and repeatedly click the CommandButton.

Rick

Private Sub CommandButton1_Click()
Dim X As Long
Dim LeftChar As String
Dim RightChar As String
Dim MyDeck(1 To 52) As String
ShuffleDeck MyDeck
With RichTextBox1
.Text = ""
.Font.Size = 18
For X = 1 To 5
LeftChar = Left$(MyDeck(X), 1)
RightChar = Right$(MyDeck(X), 1)
If Asc(RightChar) = 167 Or Asc(RightChar) = 170 Then
.SelColor = vbBlack
Else
.SelColor = vbRed
End If
.SelFontName = "Arial"
.SelText = LeftChar
.SelFontName = "Symbol"
.SelText = RightChar & vbCrLf
Next
End With
End Sub

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) = "A"
ElseIf ((X - 1) Mod 13) = 9 Then
TempDeck(X) = "T"
ElseIf ((X - 1) Mod 13) = 10 Then
TempDeck(X) = "J"
ElseIf ((X - 1) Mod 13) = 11 Then
TempDeck(X) = "Q"
ElseIf ((X - 1) Mod 13) = 12 Then
TempDeck(X) = "K"
Else
TempDeck(X) = CStr(1 + ((X - 1) Mod 13))
End If
If (X - 1) \ 13 = 0 Then
TempDeck(X) = TempDeck(X) & Chr$(170)
ElseIf (X - 1) \ 13 = 1 Then
TempDeck(X) = TempDeck(X) & Chr$(169)
ElseIf (X - 1) \ 13 = 2 Then
TempDeck(X) = TempDeck(X) & Chr$(168)
ElseIf (X - 1) \ 13 = 3 Then
TempDeck(X) = TempDeck(X) & Chr$(167)
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

"Rick Rothstein (MVP - VB)" wrote in
message ...
I'll bet you could make it even slicker by modifying this portion:

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"

So that instead of returning the string name Spades, Hearts,
Diamonds, Clubs, it returns the red or black colored symbol.

That might be somewhat difficult to do... not the coding, that is easy...
rather, where to display it at. The card suit symbols exist in the Symbol
font, as do the ten digits, but the letters (AJQK) do not. I am newly
returned to Excel after a long absence, so I may have forgotten... it
there a display object in the VBA world that can take mixed fonts like
the Form or PictureBox objects in the compiled versions of VB?

Okay, this is not a "smooth" solution (because it requires specialized
coding rather than general purpose procedures), but it sure looks neat
(and will give an idea of what is possible). Add a UserForm to the
project. Right click the Toolbox and select Additional Controls from the
popup menu. Select a Microsoft Rich Textbox Control 6.0 from the list and
click OK. Now add a reasonably tall RichTextBox control to the UserForm
along with a CommandButton. Paste the code below into the UserForm's code
window, run the project and repeatedly click the CommandButton.

Rick

Private Sub CommandButton1_Click()
Dim X As Long
Dim LeftChar As String
Dim RightChar As String
Dim MyDeck(1 To 52) As String
ShuffleDeck MyDeck
With RichTextBox1
.Text = ""
.Font.Size = 18
For X = 1 To 5
LeftChar = Left$(MyDeck(X), 1)
RightChar = Right$(MyDeck(X), 1)
If Asc(RightChar) = 167 Or Asc(RightChar) = 170 Then
.SelColor = vbBlack
Else
.SelColor = vbRed
End If
.SelFontName = "Arial"
.SelText = LeftChar
.SelFontName = "Symbol"
.SelText = RightChar & vbCrLf
Next
End With
End Sub

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) = "A"
ElseIf ((X - 1) Mod 13) = 9 Then
TempDeck(X) = "T"
ElseIf ((X - 1) Mod 13) = 10 Then
TempDeck(X) = "J"
ElseIf ((X - 1) Mod 13) = 11 Then
TempDeck(X) = "Q"
ElseIf ((X - 1) Mod 13) = 12 Then
TempDeck(X) = "K"
Else
TempDeck(X) = CStr(1 + ((X - 1) Mod 13))
End If
If (X - 1) \ 13 = 0 Then
TempDeck(X) = TempDeck(X) & Chr$(170)
ElseIf (X - 1) \ 13 = 1 Then
TempDeck(X) = TempDeck(X) & Chr$(169)
ElseIf (X - 1) \ 13 = 2 Then
TempDeck(X) = TempDeck(X) & Chr$(168)
ElseIf (X - 1) \ 13 = 3 Then
TempDeck(X) = TempDeck(X) & Chr$(167)
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

I can't get past creating the userform. When I try to add the richtextbox I
get a message: the subject is not trusted for the specified action. ??? I
don't know enough VBA to understand what that means!

Biff

I can't get past creating the userform. When I try to add the richtextbox
I get a message: the subject is not trusted for the specified action. ???
I don't know enough VBA to understand what that means!

I got that message too... and ignored it. The control is from Microsoft and
it worked fine when I used it (after ignoring the warning). Remember, I am
only trying to demonstrate the technique and am using a RichTextBox because
I am familiar with how to use it from my compiled VB experience. What I
originally wanted to do is print directly to the UserForm (like I can do to
Forms in compiled VB), but that is not allowed in Excel. Next, I looked for
a PictureBox control since, in the compiled VB world, you can print directly
to it also; but I could not find an equivalent Excel control. Is there an
Excel control that you know of which can be printed to via code?

Rick