How can I generate all 4 card combinations of a 52 card deck using VBA?

Question

I am trying to generate all combinations of 4 cards using a deck of 52 cards. Generating all the permutations would be easy (and long), but in cards, the order doesn't matter, so for instance Ah,Kh,Qh,Jh would be the same as Kh,Ah,Qh,Jh. Can anyone point me in the right direction or show me some sample code that I can use? Found it weird that no one tried this before.

I think this is more a https://math.stackexchange.com question than a programming one. — Pᴇʜ, Feb 20 '18 at 10:23
One way (not very efficient) generate all permutations, sort **each permutation** (so `1234` and `4321` become both `1234`) and remove the duplicates. — Pᴇʜ, Feb 20 '18 at 10:59
@Pᴇʜ It's a pure math problem if he's just looking to count the combinations. If he wants to actually list them out as "A♥K♥Q♥J♥" etc for some reason then less so — Chronocidal, Feb 20 '18 at 11:05
What about suits? Are 'Ah, Kh, 8d, 9d' the same as 'As, Ks, 8c, 9c' ? — ashleedawg, Feb 20 '18 at 11:06
No. Not the same. But I believe your solution covers that right? — Francisco Plácido, Feb 20 '18 at 11:12
@Chronocidal I would call developing an algorithm to calculate something a pure math problem at first. You need that algorithm first before you can start coding in any desired language. So I would say the first part is a math problem. An algorithm can be math too, it doesn't need to be done with code necessarily. There were many algorithms developed by mathematicians before coding even existed. — Pᴇʜ, Feb 20 '18 at 11:13
Possible duplicate of [Combination Algorithm in Excel VBA](https://stackoverflow.com/questions/7198154/combination-algorithm-in-excel-vba) — Emil, Jun 25 '18 at 14:21
Have you done any research? This has been answered many times on SO. — Emil, Jun 25 '18 at 14:22
Also see [Create combinations in Excel](https://stackoverflow.com/q/16820113/9898745) — Emil, Jun 25 '18 at 14:40

score 3 · Accepted Answer · edited Feb 20 '18 at 14:30

Use 4 nested loops. To prevent repeats and only count "unique sets", I think you just have to have each loop begins at: [the 'parent' loop's current value] + 1

Here's the code:

Option Explicit

Sub All4Combos()

    'Caution!  Save your work before runnning! (or set constant smaller)

    Const NumCardsInDeck = 52
    Dim c1, c2, c3, c4
    Dim p As Long

    For c1 = 1 To NumCardsInDeck
        For c2 = c1 + 1 To NumCardsInDeck
            For c3 = c2 + 1 To NumCardsInDeck
               For c4 = c3 + 1 To NumCardsInDeck

                    p = p + 1
                    Debug.Print c1, c2, c3, c4

                Next c4
            Next c3
        Next c2
    Next c1

    Debug.Print p & " Combinations of " & NumCardsInDeck & " cards"

End Sub

Result:

Number of permutations:

52 x 51 x 50 x 49

Number of combinations:

Permuations / slots!
--OR--
(52 x 51 x 50 x 49) / (4 x 3 x 2 x 1)

The result is 270725 combinations.

Here's the result set with 10 cards:

1,2,4,10
1,2,5,6
1,2,5,7
1,2,5,8
1,2,5,9
1,2,5,10
1,2,6,7
1,2,6,8
1,2,6,9
1,2,6,10
1,2,7,8
1,2,7,9
1,2,7,10
1,2,8,9
1,2,8,10
1,2,9,10
1,3,4,5
1,3,4,6
1,3,4,7
1,3,4,8
1,3,4,9
1,3,4,10
1,3,5,6
1,3,5,7
1,3,5,8
1,3,5,9
1,3,5,10
1,3,6,7
1,3,6,8
1,3,6,9
1,3,6,10
1,3,7,8
1,3,7,9
1,3,7,10
1,3,8,9
1,3,8,10
1,3,9,10
1,4,5,6
1,4,5,7
1,4,5,8
1,4,5,9
1,4,5,10
1,4,6,7
1,4,6,8
1,4,6,9
1,4,6,10
1,4,7,8
1,4,7,9
1,4,7,10
1,4,8,9
1,4,8,10
1,4,9,10
1,5,6,7
1,5,6,8
1,5,6,9
1,5,6,10
1,5,7,8
1,5,7,9
1,5,7,10
1,5,8,9
1,5,8,10
1,5,9,10
1,6,7,8
1,6,7,9
1,6,7,10
1,6,8,9
1,6,8,10
1,6,9,10
1,7,8,9
1,7,8,10
1,7,9,10
1,8,9,10
2,3,4,5
2,3,4,6
2,3,4,7
2,3,4,8
2,3,4,9
2,3,4,10
2,3,5,6
2,3,5,7
2,3,5,8
2,3,5,9
2,3,5,10
2,3,6,7
2,3,6,8
2,3,6,9
2,3,6,10
2,3,7,8
2,3,7,9
2,3,7,10
2,3,8,9
2,3,8,10
2,3,9,10
2,4,5,6
2,4,5,7
2,4,5,8
2,4,5,9
2,4,5,10
2,4,6,7
2,4,6,8
2,4,6,9
2,4,6,10
2,4,7,8
2,4,7,9
2,4,7,10
2,4,8,9
2,4,8,10
2,4,9,10
2,5,6,7
2,5,6,8
2,5,6,9
2,5,6,10
2,5,7,8
2,5,7,9
2,5,7,10
2,5,8,9
2,5,8,10
2,5,9,10
2,6,7,8
2,6,7,9
2,6,7,10
2,6,8,9
2,6,8,10
2,6,9,10
2,7,8,9
2,7,8,10
2,7,9,10
2,8,9,10
3,4,5,6
3,4,5,7
3,4,5,8
3,4,5,9
3,4,5,10
3,4,6,7
3,4,6,8
3,4,6,9
3,4,6,10
3,4,7,8
3,4,7,9
3,4,7,10
3,4,8,9
3,4,8,10
3,4,9,10
3,5,6,7
3,5,6,8
3,5,6,9
3,5,6,10
3,5,7,8
3,5,7,9
3,5,7,10
3,5,8,9
3,5,8,10
3,5,9,10
3,6,7,8
3,6,7,9
3,6,7,10
3,6,8,9
3,6,8,10
3,6,9,10
3,7,8,9
3,7,8,10
3,7,9,10
3,8,9,10
4,5,6,7
4,5,6,8
4,5,6,9
4,5,6,10
4,5,7,8
4,5,7,9
4,5,7,10
4,5,8,9
4,5,8,10
4,5,9,10
4,6,7,8
4,6,7,9
4,6,7,10
4,6,8,9
4,6,8,10
4,6,9,10
4,7,8,9
4,7,8,10
4,7,9,10
4,8,9,10
5,6,7,8
5,6,7,9
5,6,7,10
5,6,8,9
5,6,8,10
5,6,9,10
5,7,8,9
5,7,8,10
5,7,9,10
5,8,9,10
6,7,8,9
6,7,8,10
6,7,9,10
6,8,9,10
7,8,9,10
210 Combinations of 10 cards

@Vityata In a standard 52-card deck orderded 2♥-A♥,2♦-A♦,2♣-A♣,2♠-A♠ then A♥A♦A♣A♠ will be cards 13,26,39 and 52 — Chronocidal, Feb 20 '18 at 11:02
That's wasn't specified in the question. i asked for clarification. — ashleedawg, Feb 20 '18 at 11:04
Number of combinations without repetition where order does not matter can also be written as: n! / r!(n - r)!. For n = 10 and r = 4 this (also) gives 210 — , Feb 20 '18 at 12:23
While this works, it isn't very good for extending to the general case — Emil, Jun 25 '18 at 14:23

score 1 · Answer 2 · answered Feb 20 '18 at 14:11

1

For the fun of it

Building on ashleedawg's code and writing the result to a text file I got this result:

Run took 2293 milliseconds
Wrote cardcombos.txt with 270725 lines of 4-card combinations of totally 52 cards

Porting the code to C++ yielded this:

Run took 203 milliseconds
Wrote cardcombos.txt with 270725 lines of 4-card combinations of totally 52 cards

answered Feb 20 '18 at 14:11

So with the ampersands it took more time? Are you sure or your processor was doing something else as well? – Vityata Feb 20 '18 at 17:24
Of course. a long integer require more space and more registers than an integer (not entirely true) – Feb 20 '18 at 17:26
Dim c1 As Integer Dim c2 As Integer Dim c3 As Integer Dim c4 As Integer I never use Dim alone. I always specify – Feb 20 '18 at 17:28
Check this out - https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long – Vityata Feb 20 '18 at 17:29
Well, VBA (.Net, C#) will not beat unmanaged code C(++). More than 10 times faster – Feb 20 '18 at 17:32
I somehow missed your point. My initial idea was that if you declare the ashleedawg's variables like this `Dim c1&, c2&, c3&, c4&`, the VBA code will be faster than the VBA code is when the variables are `Dim c1,c2,c3,c4`. – Vityata Feb 20 '18 at 17:35
New topic suggestion: Why do we need anything but C++? – Feb 20 '18 at 17:35
Please avoid extended discussions in comments. Would you like to automatically move this discussion to chat? Nope! – Feb 20 '18 at 17:52
1

Sometimes SO is killing herself – Feb 20 '18 at 17:53

score 0 · Answer 3 · answered Feb 20 '18 at 10:59

0

This is basically an extended version of the "how many handshakes" problem....

There are a couple of ways to go about it - 1 would be to brute-force it (generate all permutations, sort the elements all into card/suit order, then delete duplicates)

A second option would be to create a deck and work through in order ("card 1 can be paired up with cards 2-52, pair 1&2 can be triaded up with cards 3-52, triad 1&2&3 can be quarteted up with cards 4-52") and remove 'used' cards from the stack for the next loop ("triad 1&2&4 can be quarteted up with cards 5-52, pair 1&3 can be triaded up with cards 4-52, card 2 can be paired up with cards 3-52") This will then stop at quartet 49&50&51&52

And, yes, it will take a long time for your workbook to work these out. Not as long as the full 6,497,400 permutations, but there are still 270,725 combinations.

answered Feb 20 '18 at 10:59

Chronocidal

6,827
1
12
26

There are waaay more combinations than that. `8.06e+67` of them. – ashleedawg Feb 20 '18 at 11:16
3

Hmm no. There are 6497400 permutations (52x51x50x49) and 270725 combinations (52x51x50x49)/(1x2x3x4). His numbers are right. – Francisco Plácido Feb 20 '18 at 11:21
4

@ashleedawg Take a 4-digit pin. There are 10 options for the first digit, 10 for the second, 10 for the third, 10 for the fourth. That's 10*10*10*10 = 10^4, not 10^10^10^10. So, picking 1 card from each of 4 different decks would give 52^4, or 7,311,616 - since we are taking all 4 cards from the same deck the number *must* be smaller than that – Chronocidal Feb 20 '18 at 11:26
1

Ah yes, you're right - My code was correct, I was doing the math wrong elsewhere! – ashleedawg Feb 20 '18 at 11:30
About 2 seconds is not long for 270,725 combinations – Feb 20 '18 at 16:07

score 0 · Answer 4 · answered Feb 20 '18 at 14:02

Made a few changes to the code provided above. Here is the final result.

Option Explicit

Sub All4Combos()

Dim Cards() As String

'Caution!  Save your work before runnning! (or set constant smaller)

Cards = Split("As,Ks,Qs,Js,Ts,9s,8s,7s,6s,5s,4s,3s,2s,Ah,Kh,Qh,Jh,Th,9h,8h,7h,6h,5h,4h,3h,2h,Ad,Kd,Qd,Jd,Td,9d,8d,7d,6d,5d,4d,3d,2d,Ac,Kc,Qc,Jc,Tc,9c,8c,7c,6c,5c,4c,3c,2c", ",")
Const NumCardsInDeck = 51
Dim c1, c2, c3, c4
Dim p As Long
p = 0
For c1 = 0 To NumCardsInDeck
    For c2 = c1 + 1 To NumCardsInDeck
        For c3 = c2 + 1 To NumCardsInDeck
           For c4 = c3 + 1 To NumCardsInDeck

                p = p + 1
                Cells(p, 1) = Cards(c1) & Cards(c2) & Cards(c3) & Cards(c4)

            Next c4
        Next c3
    Next c2
Next c1


End Sub

Vityata · Answer 5 · 2018-02-20T16:56:20.113

If we split the cards by 4 suits, each with 13 cards and use this as our base, then there are 5 different combinations of 4 cards, that can be withdrawn, if we only take care of the suits as uniqueness:

♥♦♣♠ - four different suits
♥♦♣♣ - three different suits
♣♣♥♥ - two different suits (2:2)
♣♣♣♥ - two different suits (3:1)
♥♥♥♥ - one suit only

Now, pretty much, if simulate all these possibilities for all suits, the sum of the 5 simulations should be equal to (49x50x51x52)/(4x3x2) = 270725

♥♦♣♠

For cnt1 = 1 To totalCards
    For cnt2 = 1 To totalCards
        For cnt3 = 1 To totalCards
            For cnt4 = 1 To totalCards
                numberResult = numberResult + 1
            Next : Next : Next : Next

Four nested loops are exactly what is needed. With totalCards=13 and numberResult*4 for each suit, we get 28561. Or 13^4.

♥♦♣♣

For cnt1 = 1 To totalCards
    For cnt2 = cnt1 + 1 To totalCards
        For cntA = 1 To 3
            For cnt3 = 1 To totalCards
                For cnt4 = 1 To totalCards
                    numberResult = numberResult + 1
                Next : Next : Next : Next : Next

Here the idea is that for each two cards of the same suit, there is one suit, which does not take place in our calculation. Thus, the cntA = 1 To 3. At the end, we multiply by 4 for each suit to get 158184.

♣♣♥♥

For cnt1 = 1 To totalCards
    For cnt2 = cnt1 + 1 To totalCards
        For cnt3 = 1 To totalCards
            For cnt4 = cnt3 + 1 To totalCards
                numberResult = numberResult + 1
            : Next : Next : Next : Next

We have 78 possibilities for 2 cards from the same suit. This is simulated with the first two nested loops. The other 78 possibilities for another color are with the next 2 nested loops. Thus, we have 6084 variations. However, the ways to combine 4 suits into a union of 2 are 6 (♥♣,♥♦,♥♠,♣♦,♣♠,♦♠), thus we multiply the result by 6 to get 36504.

♣♣♣♥

For cnt1 = 1 To totalCards
    For cnt2 = cnt1 + 1 To totalCards
        For cnt3 = cnt2 + 1 To totalCards
            For cnt4 = 1 To totalCards
                numberResult = numberResult + 1
            Next : Next : Next : Next

Here we have 3 equal cards and one different. Per 1 suit of 3 equal cards, we may have 3 different cards. And we have 4 suits, thus, we have to multiply by 12 (4x3) to get 44616.

♥♥♥♥

For cnt1 = 1 To totalCards
    For cnt2 = cnt1 + 1 To totalCards
        For cnt3 = cnt2 + 1 To totalCards
            For cnt4 = cnt3 + 1 To totalCards
                numberResult = numberResult + 1
            Next : Next : Next : Next

This is exactly like the accepted answer, but in this case our totalCards = 13. As far as we have 4 different suits, we multiply by 4 to get 2860.

This is the result of the code:

 28561  4 different suits.
158184  3 different suits.
 36504  2(2:2) different suits.
 44616  2(3:1) different suits.
  2860  1 suit only.
270725  All.270725

Finally, here comes the code:

Public Sub TestMe()

    Dim cnt1&, cnt2&, cnt3&, cnt4&, cntA&
    Dim totalCards&: totalCards = 13
    Dim numberResult&, totalResult&

    '4 different suits
    For cnt1 = 1 To totalCards
        For cnt2 = 1 To totalCards
            For cnt3 = 1 To totalCards
                For cnt4 = 1 To totalCards
                    numberResult = numberResult + 1
                Next: Next: Next: Next
    numberResult = numberResult
    Debug.Print " " & numberResult & vbTab & "4 different suits."
    totalResult = numberResult + totalResult
    numberResult = 0

    '3 different suits
    For cnt1 = 1 To totalCards
        For cnt2 = cnt1 + 1 To totalCards
            For cntA = 1 To 3
                For cnt3 = 1 To totalCards
                    For cnt4 = 1 To totalCards
                        numberResult = numberResult + 1
                    Next: Next: Next: Next: Next
    numberResult = numberResult * 4
    Debug.Print numberResult & vbTab & "3 different suits."
    totalResult = numberResult + totalResult
    numberResult = 0

    '2 different suits (2+2)
    For cnt1 = 1 To totalCards
        For cnt2 = cnt1 + 1 To totalCards
            For cnt3 = 1 To totalCards
                For cnt4 = cnt3 + 1 To totalCards
                    numberResult = numberResult + 1
                Next: Next: Next: Next
    numberResult = numberResult * 6
    Debug.Print " " & numberResult & vbTab & "2(2:2) different suits."
    totalResult = numberResult + totalResult
    numberResult = 0

    '2 different suits (3+1)
    For cnt1 = 1 To totalCards
        For cnt2 = cnt1 + 1 To totalCards
            For cnt3 = cnt2 + 1 To totalCards
                For cnt4 = 1 To totalCards
                    numberResult = numberResult + 1
                Next: Next: Next: Next
    numberResult = numberResult * 12
    Debug.Print " " & numberResult & vbTab & "2(3:1) different suits."
    totalResult = numberResult + totalResult
    numberResult = 0

    '1 different suit
    For cnt1 = 1 To totalCards
        For cnt2 = cnt1 + 1 To totalCards
            For cnt3 = cnt2 + 1 To totalCards
                For cnt4 = cnt3 + 1 To totalCards
                    numberResult = numberResult + 1
                Next: Next: Next: Next
    numberResult = numberResult * 4
    Debug.Print "  " & numberResult & vbTab & "1 suit only."
    totalResult = numberResult + totalResult
    numberResult = 0

    Debug.Print totalResult & vbTab & "All." & (49& * 50 * 51 * 52) / (4 * 3 * 2)

End Sub

How can I generate all 4 card combinations of a 52 card deck using VBA?

5 Answers5

Here's the code:

Result: