Option Explicit
Sub Poker_Dict()
Dim NumCards As Integer, Players As Integer
Dim Suits(), Cards()
Dim J As Variant, K As Variant
Dim CardNum As Integer, i As Integer, v As Integer, CardPick As Integer
Dim Casino As Dictionary, CardName As String
Dim NewSheet As Worksheet
Set Casino = New Dictionary
NumCards = 5
Players = 10
If NumCards * Players > 52 Then
MsgBox "You have exceeded one deck!", vbCritical
Exit Sub
End If
Application.ScreenUpdating = False
Set NewSheet = ActiveWorkbook.Sheets.Add
Suits = Array("Spades", "Clubs", "Diamonds", "Hearts")
Cards = Array("Ace", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _
"Ten", "Jack", "Queen", "King")
i = 1
For Each J In Suits
For Each K In Cards
Casino.Add K & " of " & J, i
i = i + 1
Next K
Next J
For i = 1 To Players
NewSheet.Cells(1, i) = "Player " & i
For v = 1 To NumCards
CardPick = Int(Rnd() * Casino.Count)
CardName = Casino.keys(CardPick)
NewSheet.Cells(v + 1, i) = CardName
Casino.Remove (CardName)
Next v
Next i
v = 1
NewSheet.Cells(v, i + 1) = "Undealt Cards"
For Each J In Casino
v = v + 1
NewSheet.Cells(v, i + 1) = J
Next J
NewSheet.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
Set Casino = Nothing
End Sub
Sub Poker_Coll()
Dim NumCards As Integer, Players As Integer
Dim Suits(), Cards()
Dim J As Variant, K As Variant
Dim CardNum As Integer, i As Integer, v As Integer, CardPick As Integer
Dim Casino As Collection, CardName As String
Dim NewSheet As Worksheet
Set Casino = New Collection
NumCards = 5
Players = 10
If NumCards * Players > 52 Then
MsgBox "You have exceeded one deck!", vbCritical
Exit Sub
End If
Application.ScreenUpdating = False
Set NewSheet = ActiveWorkbook.Sheets.Add
Suits = Array("Spades", "Clubs", "Diamonds", "Hearts")
Cards = Array("Ace", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _
"Ten", "Jack", "Queen", "King")
i = 1
For Each J In Suits
For Each K In Cards
Casino.Add K & " of " & J
i = i + 1
Next K
Next J
For i = 1 To Players
NewSheet.Cells(1, i) = "Player " & i
For v = 1 To NumCards
CardPick = Int(Rnd() * Casino.Count + 1)
CardName = Casino(CardPick)
NewSheet.Cells(v + 1, i) = CardName
Casino.Remove (CardPick)
Next v
Next i
v = 1
NewSheet.Cells(v, i + 1) = "Undealt Cards"
For Each J In Casino
v = v + 1
NewSheet.Cells(v, i + 1) = J
Next J
NewSheet.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
Set Casino = Nothing
End Sub
|