Displaying possible combinations

[James8309]

Hi everyone,

I was researching on how to display possible poker hands (5 cards)
using a VBA. I found this code within this group. However as you can
see, this code below does ignore the suits. Is it possible to alter
this code to display different possible poker hands including the
suits?

Thank you very much.

where;
1. Diamond = "D"
2. Heart = "H"
3. Spade = "S"
4. Clover = "C"
'Ace' being = 1, 'King' being = 13



Sub poker_hand2()

Dim card1, card2, card3, card4, card5 As Integer


For card1 = 1 To 13
For card2 = card1 To 13
For card3 = card2 To 13
For card4 = card3 To 13
For card5 = card4 To 13
If Not (card1 = card2 And card2 = card3 And
card3 =
card4 And card4 = card5) Then
ActiveCell = card1 & "-" & card2 & "-" &
card3 &
"-" & card4 & "-" & card5
If ActiveCell.Row = 65536 Then
ActiveCell.Offset(-65535, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
End If
Next card5
Next card4
Next card3
Next card2
Next card1


End Sub

 

[paul.robinson]

Hi
Try this.

Sub poker_hand2()


Dim card1 As Integer, card2 As Integer, card3 As Integer, card4 As
Integer, card5 As Integer
Application.ScreenUpdating = False

For card1 = 1 To 52
For card2 = card1 To 52
For card3 = card2 To 52
For card4 = card3 To 52
For card5 = card4 To 52
If Not (card1 = card2 And card2 = card3 And
card3 = card4 And card4 = card5) Then
ActiveCell = Card(card1) & "-" &
Card(card2) & "-" & Card(card3) & "-" & Card(card4) & "-" &
Card(card5)
If ActiveCell.Row = 65536 Then
ActiveCell.Offset(-65535, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
End If
Next card5
Next card4
Next card3
Next card2
Next card1


End Sub

Function Card(x As Integer) As String
Select Case x
Case Is <= 13: Card = x & "D"
Case Is <= 26: Card = x & "H"
Case Is <= 39: Card = x & "S"
Case Else: Card = x & "C"
End Select
End Function

As usual, careful with the line wrapping. Also note that
Dim card 1, card2 as integer

makes Card2 an integer but Card1 a variant. What you mean is
Dim card 1 as integer, card2 as integer

If you don't do this, you will get an error calling the function Card.
regards
Paul

 

[James8309]

Hi
Try this.

Sub poker_hand2()

Dim card1 As Integer, card2 As Integer, card3 As Integer, card4 As
Integer, card5 As Integer
Application.ScreenUpdating = False

    For card1 = 1 To 52
        For card2 = card1 To 52
            For card3 = card2 To 52
                For card4 = card3 To 52
                    For card5 = card4 To 52
                        If Not (card1 = card2 And card2 = card3 And
card3 = card4 And card4 = card5) Then
                            ActiveCell = Card(card1) & "-" &
Card(card2) & "-" & Card(card3) & "-" & Card(card4) & "-" &
Card(card5)
                            If ActiveCell.Row= 65536 Then
                                ActiveCell.Offset(-65535, 1).Select
                            Else
                                ActiveCell.Offset(1, 0).Select
                            End If
                        End If
                    Next card5
                Next card4
            Next card3
        Next card2
    Next card1

End Sub

Function Card(x As Integer) As String
Select Case x
    Case Is <= 13: Card = x & "D"
    Case Is <= 26: Card = x & "H"
    Case Is <= 39: Card = x & "S"
    Case Else: Card = x & "C"
End Select
End Function

As usual, careful with the line wrapping. Also note that
Dim card 1, card2 as integer

makes Card2 an integer but Card1 a variant. What you mean is
Dim card 1 as integer, card2 as integer

If you don't do this, you will get an error calling the function Card.
regards
Paul










- Show quoted text -

Thanks mate. You are a champ.

 

[paul.robinson]

Hi
Just to finish the thread with the error you noticed. The Card
function should be

Function Card(x As Integer) As String
Select Case x
Case Is <= 13: Card = x & "D"
Case Is <= 26: Card = x-13 & "H"
Case Is <= 39: Card = x-26 & "S"
Case Else: Card = x-39 & "C"
End Select
End Function

or cards are numbered 1 to 52 instead of four suits of 1 to 13.

regards
Paul

 

[James8309]

Hi
Just to finish the thread with the error you noticed. The Card
function should be

Function Card(x As Integer) As String
Select Case x
Case Is <= 13: Card = x & "D"
Case Is <= 26: Card = x-13 & "H"
Case Is <= 39: Card = x-26 & "S"
Case Else: Card = x-39 & "C"
End Select
End Function

or cards are numbered 1 to 52 instead of four suits of 1 to 13.

regards
Paul





- µû¿Â ÅؽºÆ® º¸±â -

Really really smart they way you added Function.

It works beautifully! except that 5 card combinations have some
unrealistic combos where more than 1 same card is within those 5 cards
i.e. 1D-1D-1D-1D-1D

I tried thinking how I can prevent or delete those combination where
there are more than 1 same card but it is surely proving difficulties
lol.

I owe you a big steak!!

Have a good night mate.

 

[Dana DeLouis]

Here's what I hand in mind for a deck of 52 cards.
However, I just realized that the letters "J" & "Q" are not really part of the "Symbol" font.
I'm not sure what the best workaround would be at this point.
This does not return an array, just displays the general idea on the worksheet.


Sub DeckOfCards()
Dim c
Dim s
Dim J, K, R
R = 1
c = Array(0, "A", 2, 3, 4, 5, 6, 7, 8, 9, 10, "J", "Q", "K")
s = Array(0, Chr(167), Chr(168), Chr(169), Chr(170))
For J = 1 To 4
For K = 1 To 13
Cells(R, 1) = c(K) & s(J)
R = R + 1
Next K
Next J
Columns("A:A").Font.Name = "Symbol"
Range("A14:A39").Font.Color = -16776961
End Sub


--
Dana DeLouis

<snip>

 

[paul.robinson]

Hi
This was taken care of originally in the line
If Not (card1 = card2 And card2 = card3 And
card3 = card4 And card4 = card5) Then

when there were 13 cards, but does not work for 52 as cards 1 and 14
(say) are both card 1 of two different suits. Replace all the

card1 = card2 bits

with

Card(Card1) = Card(card2)

to catch the card number and suit and, fingers crossed, things should
now work.
regards
Paul

 

[James8309]

Hi
This was taken care of originally in the line
If Not (card1 = card2 And card2 = card3 And
card3 = card4 And card4 = card5) Then

when there were 13 cards, but does not work for 52 as cards 1 and 14
(say) are both card 1 of two different suits. Replace all the

card1 = card2 bits

with

Card(Card1) = Card(card2)

to catch the card number and suit and, fingers crossed, things should
now work.
regards
Paul









- Show quoted text -

Hmmmm, It didn't really make the difference.

Mathematically it should give 2,598,600 combinations but this code
gives me 3,819,764

I understand that it is mainly due to order of same 5 cards. It is
just really hard to remove those duplicate card within 5 cards.

 

[paul.robinson]

Hi
That's me not testing stuff. I was being to complicated with it. This
will work (I think...)

If (card1 < card2 And card2 < card3 And card3 < card4 And card4 <
card5) Then

There must be a standard & most efficient way of listing combinations
too - which this definitely isn't!.
regards
Paul