"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