Multiple Random Number Generator in Range

[cdill]

I'm doing a card draw simulation. I need to draw 8 random cards (with no duplicates) out of 52. I'll include my code below which is giving me a Run Time 28 error (Out of Stack Space). I am pretty sure my problem exists where I actually have Subs that call to themselves. I am sure there is an easier way to do this, but couldn't think of one.

Hopefully this is pretty clear what my intentions were. I just wanted to generate 8 integers (CARD1 - CARD8) out of a range between 1-52 (a deck of cards) and then display them in cells A1-A8.

Any help is appreciated.

   Dim CARD1 As Integer   
   Dim CARD2 As Integer
   Dim CARD3 As Integer
   Dim CARD4 As Integer
   Dim CARD5 As Integer
   Dim CARD6 As Integer
   Dim CARD7 As Integer
   Dim CARD8 As Integer


Sub DRAW8CARDS()
CARD1RAND
CARD2RAND
CARD3RAND
CARD4RAND
CARD5RAND
CARD6RAND
CARD7RAND
CARD8RAND
Sheets("Sheet1").Range("A1").Value = CARD1
Sheets("Sheet1").Range("A2").Value = CARD2
Sheets("Sheet1").Range("A3").Value = CARD3
Sheets("Sheet1").Range("A4").Value = CARD4
Sheets("Sheet1").Range("A5").Value = CARD5
Sheets("Sheet1").Range("A6").Value = CARD6
Sheets("Sheet1").Range("A7").Value = CARD7
Sheets("Sheet1").Range("A8").Value = CARD8
End Sub


Sub CARD1RAND()
CARD1 = Int((52 - 1 + 1) * Rnd + 52)
End Sub
Sub CARD2RAND()
CARD2 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD2 = CARD1 Then
    CARD2RAND
    End If
End Sub
Sub CARD3RAND()
CARD3 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD3 = (CARD1) Or (CARD2) Then
    CARD3RAND
    End If
End Sub
Sub CARD4RAND()
CARD4 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD4 = (CARD1) Or (CARD2) Or (CARD3) Then
    CARD4RAND
    End If
End Sub
Sub CARD5RAND()
CARD5 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD5 = (CARD1) Or (CARD2) Or (CARD3) Or (CARD4) Then
    CARD5RAND
    End If
End Sub
Sub CARD6RAND()
CARD6 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD6 = (CARD1) Or (CARD2) Or (CARD3) Or (CARD4) Or (CARD5) Then
    CARD6RAND
    End If
End Sub
Sub CARD7RAND()
CARD7 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD7 = (CARD1) Or (CARD2) Or (CARD3) Or (CARD4) Or (CARD5) Or (CARD6) Then
    CARD7RAND
    End If
End Sub
Sub CARD8RAND()
CARD8 = Int((52 - 1 + 1) * Rnd + 52)
    If CARD8 = (CARD1) Or (CARD2) Or (CARD3) Or (CARD4) Or (CARD5) Or (CARD6) Or (CARD7) Then
    CARD8RAND
    End If
End Sub

 

[BrianJN1]

While I cannot see how to progress here, I note that if I select your Sub Draw8Cards then I get the error to which you refer. If I relocate those Dim statements which you have at the top of your code within Draw8Cards then everything runs from start to finish without error! There is a problem though, every value posted is "0".

Anyway, that may give you some thoughts as to how you may solve the problem.

 

[Peter_SSs]

I just wanted to generate 8 integers (CARD1 - CARD8) out of a range between 1-52 (a deck of cards) and then display them in cells A1-A8.

See if this helps

Sub DrawCards()
  Dim AllCards(1 To 52) As String, DrawnCards() As String
  Dim i As Long, k As Long
  Dim tmp As String
  
  Const NumCards As Long = 8 '<- Change this if you want a different number of cards drawn
  
  ReDim DrawnCards(1 To NumCards, 1 To 1)
  For i = 1 To 52
    AllCards(i) = "CARD" & i
  Next i
  For i = 1 To NumCards
    k = 1 + Int(Rnd() * (53 - i))
    tmp = AllCards(k)
    DrawnCards(i, 1) = tmp
    AllCards(k) = AllCards(53 - i)
  Next i
  Range("A1").Resize(NumCards).Value = DrawnCards
End Sub

 

[mrhstn]

Here's my attempt, hope it helps

Option Explicit


Sub Draw8Cards()
Dim cards(0 To 7) As Variant
Dim draw As Integer
Dim card As Integer
draw = 0
Do Until draw = 8
        
    card = Int((52 - 1 + 1) * Rnd + 1)
    If CheckCard(card, cards) = True Then
        cards(draw) = card
        draw = draw + 1
    End If
Loop
Range("A1:A8") = Application.Transpose(cards)
End Sub


Function CheckCard(card As Integer, cards() As Variant) As Boolean
Dim i As Long
CheckCard = True
For i = 0 To UBound(cards)
    If cards(i) = card Then
        CheckCard = False
        Exit For
    End If
Next i
End Function

 

[cdill]

PeterSS and mrhstn, both options work great. Not sure I understand all of it but they both serve me perfectly. Thank you.

Thank you both. I think this will help me get going

 

[Peter_SSs]

PeterSS and mrhstn, both options work great. Not sure I understand all of it but they both serve me perfectly. Thank you.

You are welcome.

Just a comment. In practice it won't happen, but in theory, mrhstn's code could get in an infinite loop. If the first card chosen is Card 6 then the random number generator could choose 6 again next time. In that case the CheckCard function will force a new random number, which could be 6 again etc. etc.
As I've said, it won't happen indefinitely but my code will directly pick 8 (or whatever number you want) different cards as it automatically prevents a duplicate being picked.

 

[cdill]

Thank you so much! So appreciated.

 

[Ingolf]

@Peter_SSs

Hi.
I need that output number be in row not in column.
How can I modify your code?

Thanks.

 

[Fluff]

Hia
Try changing the last line of Peter's code to this

Range("A1").Resize(, NumCards).Value = Application.Transpose(DrawnCards)

 

[Rick Rothstein]

See if this helps

Sub DrawCards()
  Dim AllCards(1 To 52) As String, DrawnCards() As String
  Dim i As Long, k As Long
  Dim tmp As String
  
  Const NumCards As Long = 8 '<- Change this if you want a different number of cards drawn
  
  ReDim DrawnCards(1 To NumCards, 1 To 1)
  For i = 1 To 52
    AllCards(i) = "CARD" & i
  Next i
  For i = 1 To NumCards
    k = 1 + Int(Rnd() * (53 - i))
    tmp = AllCards(k)
    DrawnCards(i, 1) = tmp
    AllCards(k) = AllCards(53 - i)
  Next i
  Range("A1").Resize(NumCards).Value = DrawnCards
End Sub

You might want to add a Randomize statement to your code, otherwise it will deal the same hands in the same order every time the workbook is opened anew. I usually like to do it by placing this code snippet at the beginning of the subroutine (or function) I use it in, just below the Dim statements, so that the Randomize statement is only executed once per use of the subroutine (or function)...

  Static AlreadyRandomized As Boolean
  If Not AlreadyRandomized Then
    Randomize
    AlreadyRandomized = True
  End If