Search code examples
excelvbapoker

Poker Dealer Logic


I'd like to use Excel as my poker dealer. Here is the code that will generate 20 random numbers (cards) between 1 and 52. Output of first 20 numbers/cards is in column A1:A20. I'd like to have the next set of 20 numbers/cards generated in A22:A41, 3rd A43:A62, and so on. How can the code be fixed so that it displays 1000 hands in column A with one row separating each set? Thank you.

Sub cards()

Range("A:A").Clear

cardstodraw = 20

For x = 1 To cardstodraw

begL:
    ActiveSheet.Cells(1, 2) = "=Randbetween(1,52)"
    ActiveSheet.Cells(x, 1) = ActiveSheet.Cells(1, 2).Text
    cardvalue = ActiveSheet.Cells(x, 1)
        y = 1
        Count = 0
        Do Until ActiveSheet.Cells(y, 1) = ""
            If ActiveSheet.Cells(y, 1) = cardvalue Then
            Count = Count + 1
            End If:  y = y + 1:  Loop
            If Count > 1 Then GoTo begL

    Next

    Range("B1").Clear


End Sub

Solution

  • Your code is somewhat convoluted (using GoTo is usually an indication that something can be improved). For getting a sample of size 20 from 1-52, use a modified Fisher-Yates shuffle:

    Option Explicit 'you really should be using this
    
    Function deal(n As Long, k As Long) As Variant
        'returns an array of length k
        'consisting of k numbers in the range 1 to n
    
        Dim deck As Variant
        Dim i As Long, j As Long, temp As Long
    
        ReDim deck(1 To n)
        For i = 1 To n
            deck(i) = i
        Next i
    
        With Application.WorksheetFunction
            'do k steps of a Fisher-Yates shuffle on deck
            For i = 1 To .Min(k, n - 1)
                j = .RandBetween(i, n)
                If i < j Then 'swap
                    temp = deck(i)
                    deck(i) = deck(j)
                    deck(j) = temp
                End If
            Next i
        End With
    
        ReDim Preserve deck(1 To k)
        deal = deck
    End Function
    

    If you want to have 1000 hands in Column A:

    Sub ManyHands()
        Dim i As Long
        With Application.WorksheetFunction
            For i = 1 To 1000
                Range(Cells(1 + 21 * (i - 1), 1), Cells(21 * i - 1, 1)).Value = .Transpose(deal(52, 20))
            Next i
        End With   
    End Sub
    

    On Edit Here is a modified version of the code, one which deals cards to multiple players:

    Function deal(n As Long, k As Long, players As Long) As Variant
        'returns an array with k rows and players columns
        'consisting of k*players numbers in range 1 to n
        'if players = 1, then the array is 1-dimensional
        'otherwise it is 2-dimensional
    
        Dim deck As Variant
        Dim i As Long, j As Long, temp As Long
        Dim hands As Variant
    
        ReDim deck(1 To n)
        For i = 1 To n
            deck(i) = i
        Next i
    
        With Application.WorksheetFunction
            'do k*players steps of a Fisher-Yates shuffle on deck
            For i = 1 To .Min(k * players, n - 1)
                j = .RandBetween(i, n)
                If i < j Then 'swap
                    temp = deck(i)
                    deck(i) = deck(j)
                    deck(j) = temp
                End If
            Next i
        End With
    
        ReDim Preserve deck(1 To k * players)
        If players = 1 Then
            deal = deck
            Exit Function
        Else
            ReDim hands(1 To k, 1 To players)
            For i = 1 To k
                For j = 1 To players
                    hands(i, j) = deck(players * (i - 1) + j)
                Next j
            Next i
        deal = hands
        End If
    End Function
    

    It could be used like:

    Sub ManyHands()
        Dim i As Long
        For i = 1 To 1000
            Range(Cells(1 + 11 * (i - 1), 1), Cells(11 * i - 1, 2)).Value = deal(52, 10, 2)
        Next i  
    End Sub