I want to set up a simple card game using excel.

Gambler wrote:
I want to set up a simple card game using excel.

Normally, you make a circular linked list, randomize, delete the card
dealt, randomize, find the next one.

Here is a generalized function for shuffling a 1D long array:

Public Function ShuffleArray(varr)

'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139
'
'
Dim List() As Long
Dim t As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

t = UBound(varr, 1) - LBound(varr, 1) + 1
ReDim List(1 To t)
For i = 1 To t
List(i) = varr(i)
Next
j = t
Randomize
For i = 1 To t
k = Rnd() * j + 1
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
ShuffleArray = List
End Function


Call it like this:

Sub MyCards()
Dim varr()
Dim varr1
Dim Cards() As String
Dim Suit As Variant
Dim cVal As Variant
Dim cnt As Long, i As Long, j As Long
Suit = Array("Heart", "Spade", _
"Diamond", "Club")
cVal = Array("A", 2, 3, 4, 5, 6, 7, _
8, 9, 10, "J", "K", "A")
ReDim Cards(1 To 52)
cnt = 1
For i = LBound(Suit) To UBound(Suit)
For j = LBound(cVal) To UBound(cVal)
Cards(cnt) = cVal(j) & "-" & Suit(i)
cnt = cnt + 1
Next
Next
ReDim varr(1 To 52)
For i = 1 To 52
varr(i) = i
Next
varr1 = ShuffleArray(varr)
cnt = 1
' deal the cards
For Each cell In Range("A1:A52")
cell.Value = Cards(varr1(cnt))
cnt = cnt + 1
Next
End Sub


--
Regards,
Tom Ogilvy


"Gambler" wrote in message
...
I want to set up a simple card game using excel.

Tom, you have a typo in there, two A's looks like one should be a Q
cVal = Array("A", 2, 3, 4, 5, 6, 7, _
8, 9, 10, "J", "K", "A")


--
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2002 & 2003

"Tom Ogilvy" wrote in message
...
Here is a generalized function for shuffling a 1D long array:

Public Function ShuffleArray(varr)

'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139
'
'
Dim List() As Long
Dim t As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

t = UBound(varr, 1) - LBound(varr, 1) + 1
ReDim List(1 To t)
For i = 1 To t
List(i) = varr(i)
Next
j = t
Randomize
For i = 1 To t
k = Rnd() * j + 1
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
ShuffleArray = List
End Function


Call it like this:

Sub MyCards()
Dim varr()
Dim varr1
Dim Cards() As String
Dim Suit As Variant
Dim cVal As Variant
Dim cnt As Long, i As Long, j As Long
Suit = Array("Heart", "Spade", _
"Diamond", "Club")
cVal = Array("A", 2, 3, 4, 5, 6, 7, _
8, 9, 10, "J", "K", "A")
ReDim Cards(1 To 52)
cnt = 1
For i = LBound(Suit) To UBound(Suit)
For j = LBound(cVal) To UBound(cVal)
Cards(cnt) = cVal(j) & "-" & Suit(i)
cnt = cnt + 1
Next
Next
ReDim varr(1 To 52)
For i = 1 To 52
varr(i) = i
Next
varr1 = ShuffleArray(varr)
cnt = 1
' deal the cards
For Each cell In Range("A1:A52")
cell.Value = Cards(varr1(cnt))
cnt = cnt + 1
Next
End Sub


--
Regards,
Tom Ogilvy


"Gambler" wrote in message
...
I want to set up a simple card game using excel.

Thanks for catching the typo.

--
Regards,
Tom Ogilvy


"Paul B" wrote in message
...
Tom, you have a typo in there, two A's looks like one should be a Q
cVal = Array("A", 2, 3, 4, 5, 6, 7, _
8, 9, 10, "J", "K", "A")


--
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2002 & 2003

"Tom Ogilvy" wrote in message
...
Here is a generalized function for shuffling a 1D long array:

Public Function ShuffleArray(varr)

'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139
'
'
Dim List() As Long
Dim t As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

t = UBound(varr, 1) - LBound(varr, 1) + 1
ReDim List(1 To t)
For i = 1 To t
List(i) = varr(i)
Next
j = t
Randomize
For i = 1 To t
k = Rnd() * j + 1
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
ShuffleArray = List
End Function


Call it like this:

Sub MyCards()
Dim varr()
Dim varr1
Dim Cards() As String
Dim Suit As Variant
Dim cVal As Variant
Dim cnt As Long, i As Long, j As Long
Suit = Array("Heart", "Spade", _
"Diamond", "Club")
cVal = Array("A", 2, 3, 4, 5, 6, 7, _
8, 9, 10, "J", "K", "A")
ReDim Cards(1 To 52)
cnt = 1
For i = LBound(Suit) To UBound(Suit)
For j = LBound(cVal) To UBound(cVal)
Cards(cnt) = cVal(j) & "-" & Suit(i)
cnt = cnt + 1
Next
Next
ReDim varr(1 To 52)
For i = 1 To 52
varr(i) = i
Next
varr1 = ShuffleArray(varr)
cnt = 1
' deal the cards
For Each cell In Range("A1:A52")
cell.Value = Cards(varr1(cnt))
cnt = cnt + 1
Next
End Sub


--
Regards,
Tom Ogilvy


"Gambler" wrote in message
...
I want to set up a simple card game using excel.