Option Explicit 
 
Sub Poker_Dict() 
     ' Requires a reference to the Microsoft Scripting Runtime
    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 
     ' number of cards
    NumCards = 5 
     ' number of players
    Players = 10 
     
    If NumCards * Players > 52 Then 
        MsgBox "You have exceeded one deck!", vbCritical 
        Exit Sub 
    End If 
     
    Application.ScreenUpdating = False 
     
     'Add a new sheet for the game
    Set NewSheet = ActiveWorkbook.Sheets.Add 
     
     'Requires Excel 2000+ to use Array
    Suits = Array("Spades", "Clubs", "Diamonds", "Hearts") 
    Cards = Array("Ace", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _ 
    "Ten", "Jack", "Queen", "King") 
     
     ' Add the cards to the Dictionary Object.
    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 
     
     'Pick a random card, deal it and remove it from the pack
    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 
     
     'dump undealt cards
    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 
     
     'Autofit columns
    NewSheet.UsedRange.EntireColumn.AutoFit 
     
     'show the result
    Application.ScreenUpdating = True 
     
    Set Casino = Nothing 
     
End Sub 
 
 
Sub Poker_Coll() 
     'Uses a collection not a dictionary
    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 
     ' number of cards
    NumCards = 5 
     ' number of players
    Players = 10 
     
    If NumCards * Players > 52 Then 
        MsgBox "You have exceeded one deck!", vbCritical 
        Exit Sub 
    End If 
     
    Application.ScreenUpdating = False 
     
     'Add a new sheet for the game
    Set NewSheet = ActiveWorkbook.Sheets.Add 
     
     'Requires Excel 2000+ to use Array
    Suits = Array("Spades", "Clubs", "Diamonds", "Hearts") 
    Cards = Array("Ace", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _ 
    "Ten", "Jack", "Queen", "King") 
     
     ' Add the cards to the Collection
    i = 1 
    For Each J In Suits 
        For Each K In Cards 
            Casino.Add K & " of " & J 
            i = i + 1 
        Next K 
    Next J 
     
     'Pick a random card, deal it and remove it from the pack
    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 
     
     'dump undealt cards
    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