VBA poker hands

Question

I'm trying to write code that will generate 4 random poker hands
_{(source: wiseowl.co.uk)}

The values should be, obviously, unique. Here's the code that I have tried already, however I can't make it work.

Sub poker_is_hard()

Dim r As Range
Dim c As Variant
Dim s As Variant
Dim cs As Variant

Set r = Workbooks("Poker game.xls").Worksheets("Cards").Range("B2:E6")
cs = c & "" & s

For Each cs In r

    c = Int(Math.Rnd * 13) + 1

    'Card's value
    If c = 11 Then
        c = "J"
    ElseIf c = 12 Then
        c = "Q"
    ElseIf c = 13 Then
        c = "K"
    ElseIf c = 1 Then
        c = "A"
    Else
    End If

    'Card's symbol
    s = Int(Math.Rnd * 4) + 1

    If s = 1 Then
        s = ThisWorkbook.Worksheets("Symbols").Range("B1").Value
    ElseIf s = 2 Then
        s = ThisWorkbook.Worksheets("Symbols").Range("B2").Value
    ElseIf s = 3 Then
        s = ThisWorkbook.Worksheets("Symbols").Range("B3").Value
    Else
        s = ThisWorkbook.Worksheets("Symbols").Range("B4").Value
    End If

 Next cs

 End Sub

Bond · Answer 1 · 2015-08-22T20:18:55.447

2

Change cs to type Range instead of Variant to iterate cells instead of cell values.
```
Dim cs As Range
```
Move the following line into your loop so that it runs for each card that's generated.
```
cs = c & "" & s
```
Place it right before Next cs

BTW, an easier way to generate cards might be like this:

Const SUITS As String = "CDHS"
Const RANKS As String = "A23456789TJQK"

Dim s As String, r As String
s = Mid$(SUITS, Int(Math.Rnd *  4) + 1, 1)
r = Mid$(RANKS, Int(Math.Rnd * 13) + 1, 1)

Or, take advantage of Unicode:

Dim SUITS As String
SUITS = ChrW$(9824) & ChrW$(9827) & ChrW$(9829) & ChrW$(9830) ' ♠♣♥♦

edited Aug 22 '15 at 20:18

answered Aug 22 '15 at 16:05

Bond

16,071
6
30
53

What does the `$` do in `Mid`? – BruceWayne Aug 22 '15 at 17:26
1

@BruceWayne - Treats the values as `String` instead of a `Variant`. It's not necessary but prevents conversion to `Variant` and back to `String` again. – Bond Aug 22 '15 at 17:29
2

@BruceWayne `$` is the String version of the Mid() function. If ommitted, the Variant version is used instead. The String version is quicker. – Excel Hero Aug 22 '15 at 17:29
Ahh - is there a different in using `$` over `cStr()?` ...ie, `cStr(Mid(SUITS,INT(Math.Rnd*4)+1,1))`? – BruceWayne Aug 22 '15 at 17:44
1

@BruceWayne - Yes because no type-conversion happens with `Mid$()`. With `Mid()`, however, all string params get type-converted to `Variant` and the return value gets type-converted from `Variant` to `String`. – Bond Aug 22 '15 at 17:50
I think I get it. Can you only do that `$` with `Mid()`? Or can you do that with many things? (What's the `$` called in VB/Excel, so I can look this up on my own)? – BruceWayne Aug 22 '15 at 17:52
1

@BruceWayne - Nearly every VBA string function has a `$` version. See [here](http://www.vb6.us/tutorials/vb6-string-functions) for examples. It's not official documentation (and it's for VB6) but it should suffice. – Bond Aug 22 '15 at 17:56
Can you explain how to enter the Unicode string into the VBE? – Excel Hero Aug 22 '15 at 18:08
@Bond, mate, any idea how to make the each cs value unique in the range? – Dmitry Vasilyev Aug 22 '15 at 19:37
@DmitryVasilyev - Typically in these types of scenarios, you would generate all possible values and store them in an array/collection. In your case, you would generate all 52 cards. Then, randomly create an index into the array (1-52, for example) and remove that item. Then, create the next random number (1-51, now) and remove another. Contain this process for the remaining cards. – Bond Aug 22 '15 at 19:53
@ExcelHero - While VBA uses Unicode for strings, apparently the VBE saves text/code in Windows-1252 charset, so I guess you can't enter them directly. I updated that portion of the answer. The best you can do is probably use `ChrW()` to create the Unicode string at run-time. Shame. – Bond Aug 22 '15 at 20:02
This answer, and the OP does not guarantee non-duplicate cards. A better way is to create a 52 element array, fill it sequentially, [shuffle it](http://stackoverflow.com/a/18543399/445425), then deal from the top – chris neilsen Aug 22 '15 at 22:18
@chrisneilsen - Yep. I suggested something similar two comments above yours. – Bond Aug 22 '15 at 22:19
@bond not really. Key point here to shuffle the deck then deal off the top. – chris neilsen Aug 23 '15 at 00:47
@chrisneilsen - It seems to me they're just two ways of going about the same thing. 1) Draw from a deck in a random order or, 2) Draw from a random deck in order. – Bond Aug 23 '15 at 00:49
@chrisneilsen and Bond, The method I used in my answer here is first shuffle and then deal from the top. – Excel Hero Aug 23 '15 at 04:18

Excel Hero · Accepted Answer · 2015-08-22T23:19:49.030

This is more than OP asked for, but here is some more to look at. The result is similar to the image provided by OP in that the hands are dealt to the range beginning at [B2] on a worksheet.

I'm using the Fisher–Yates shuffle.

Just run the Deal() routine:

Public Sub Deal()
    Const PLAYERS = 6, CARDS = 5
    Dim i&, j&, k&, deck
    CreateAndShuffle deck
    ReDim hands(1 To CARDS, 1 To PLAYERS)
    For i = 1 To CARDS
        For j = 1 To PLAYERS
            k = k + 1
            hands(i, j) = deck(k)
        Next
    Next
    [b2].Resize(CARDS, PLAYERS) = hands
End Sub
Private Sub CreateAndShuffle(a)
    Dim i&, j&, k&, p&, suit
    ReDim a(1 To 52)
    suit = Array(ChrW$(9829), ChrW$(9830), ChrW$(9827), ChrW$(9824))
    Randomize
    For i = 1 To 13
        For j = 0 To 3
            k = k + 1
            p = Int((k - 1 + 1) * Rnd + 1)
            If j <> k Then a(k) = a(p)
            a(p) = Mid$("A234567890JQK", i, 1): If i = 10 Then a(p) = 10
            a(p) = a(p) & " " & suit(j)
        Next
    Next
End Sub

VBA poker hands

2 Answers2