VBA code for Poker Game not working

[mariner1019]

hello all,
long time user and benefitter of this site. Thank you in advance for your help. I have developed an algorithum to deal 4 hands of poker randomly. I thought I had developed it so that cards would not repeat (ie two players cant have a queen of diamonds) but roughly 10% of the time i spot a repeated card and cannot figure out why. Hopefully someone can help.

The excel file i use has two tabs: sheet 1 holds the dealt cards and sheet 2 contains four symbols (heart,diamond,spade,andclub).

Here is my code:
Private Sub CommandButton1_Click()

Dim no, i, n, s, symnum As Integer
Dim cardcell, symbol, newcard As String
Dim cell As Range
For i = 2 To 6
For n = 2 To 5

ActiveWorkbook.Sheets(2).Select

symnum = Int(Math.Rnd * 4) + 1 'get symbol from sheet 2

cardcell = "B" & symnum
symbol = ActiveSheet.Range(cardcell).Value


ActiveWorkbook.Sheets(1).Select
Rows(i).Columns.Select
no = Int(Math.Rnd * 13) + 1 'generate a random number
ActiveSheet.Rows(i).Columns.Value = no
Select Case Rows(i).Columns.Value
Case "11"
Rows(i).Columns.Value = "J"
Case "12"
Rows(i).Columns.Value = "Q"
Case "13"
Rows(i).Columns.Value = "K"
Case "1"
Rows(i).Columns.Value = "A"
End Select

ActiveCell.Value = ActiveCell.Value & symbol 'combine number and symbol
newcard = ActiveCell.Value

If symnum = 1 Or symnum = 2 Then 'add binary code according to symbol
ActiveCell.Value = ActiveCell.Value & 1
Else
ActiveCell.Value = ActiveCell.Value & 0
End If

If Right(ActiveCell.Value, 1) = "1" Then ' color card based on binary code
ActiveCell.Value = Left(ActiveCell.Value, Len(ActiveCell) - 1)
ActiveCell.Font.Color = RGB(250, 0, 0)
Else
ActiveCell.Value = Left(ActiveCell.Value, Len(ActiveCell) - 1)
ActiveCell.Font.Color = RGB(0, 0, 0)
End If

For Each cell In Range("AllHands") 'delete any repeats. "allhands" is the range of the cards dealt on sheet 1
If cell.Value = newcard And cell.Address <> ActiveCell.Address Then
cell.ClearContents
End If
Next

For Each cell In Range("AllHands") ' replace empty cells with a new card
If cell.Value = Empty Then
cell.Value = GetCard
cell.Select
If Right(ActiveCell.Value, 1) = "1" Then 'color new card according to binary code
ActiveCell.Value = Left(ActiveCell.Value, Len(ActiveCell) - 1)
ActiveCell.Font.Color = RGB(250, 0, 0)
Else
ActiveCell.Value = Left(ActiveCell.Value, Len(ActiveCell) - 1)
ActiveCell.Font.Color = RGB(0, 0, 0)
End If
End If
Next

Next n
Next i
End Sub



Function GetCard() As String
Dim symnum As Integer
Dim cardcell, symbol, newcard, no, tempcard As String
Dim cell As Range

ActiveWorkbook.Sheets(2).Select

symnum = Int(Math.Rnd * 4) + 1 'grab random symbol
cardcell = "B" & symnum
symbol = ActiveSheet.Range(cardcell).Value
no = Int(Math.Rnd * 13) + 1 ' generate random number

Select Case no
Case "11"
no = "J"
Case "12"
no = "Q"
Case "13"
no = "K"
Case "1"
no = "A"
End Select
tempcard = no & symbol
GetCard = no & symbol ' combine symbol and number

ActiveWorkbook.Sheets(1).Select

For Each cell In Range("AllHands") 'check to make sure card isnt already there
If cell.Value = tempcard Then
GetCard
End If
Next

If symnum = 1 Or symnum = 2 Then ' assign binary code to card based on symbol
GetCard = GetCard & 1
Else
GetCard = GetCard & 0
End If

End Function