Dealing Cards (XP)

Topic

New Reply

I am using the following procedure to write card values to Columns A and B generated from an array. I have been trying to write only 10 unique cards from the array to the columns to simulate dealing 10 cards from a pack but. as yet, to no avail. I would be grateful for suggestions to modify the procedure to accomplish the task.

Sub MakeDeck()

Dim BasicDeck(52, 2)

‘Basic Deck: Each card sequentially indexed 1 to 52
‘The first modifier is FaceValue
‘the second modifier is Suit

For Index = 1 To 13

Select Case Index

Case 1
FaceValue = “Ace”

Case 2
FaceValue = “2”

Case 3
FaceValue = “3”

Case 4
FaceValue = “4”

Case 5
FaceValue = “5”

Case 6
FaceValue = “6”

Case 7
FaceValue = “7”

Case 8
FaceValue = “8”

Case 9
FaceValue = “9”

Case 10
FaceValue = “10”

Case 11
FaceValue = “Jack”

Case 12
FaceValue = “Queen”

Case 13
FaceValue = “King”

End Select

BasicDeck(Index, 1) = FaceValue
BasicDeck(Index, 2) = “Hearts”

BasicDeck(Index + 13, 1) = FaceValue
BasicDeck(Index + 13, 2) = “Clubs”

BasicDeck(Index + 26, 1) = FaceValue
BasicDeck(Index + 26, 2) = “Diamonds”

BasicDeck(Index + 39, 1) = FaceValue
BasicDeck(Index + 39, 2) = “Spades”

Next Index

Sheets(“Sheet1”).Select
For X = 1 To 52
Range(“A” & X) = BasicDeck(X, 1)
Range(“B” & X) = BasicDeck(X, 2)
Next X

End Sub

TIA

Regards

Reply | Quote

Replies

See attached text file.

Reply | Quote

Many thanks again, Hans.

Reply | Quote

Hi Rob

I have done a little differently using arrays, maybe you can play with this:

Sub MakeDeck()

Dim CardValue(0 To 12)
Dim CardNo As Integer
Dim CardText
Dim SuitValue(0 To 3)
Dim SuitNo
Dim SuitText
Dim i As Integer

For SuitNo = LBound(SuitValue) To UBound(SuitValue)

SuitText = Array(“Hearts”, “Clubs”, “Diamonds”, “Spades”)

For CardNo = LBound(CardValue) To UBound(CardValue)
i = i + 1
CardText = Array(“Ace”, “Two”, “Three”, “Four”, “Five”, “Six”, “Seven”, “Eight”, “Nine”, “Ten”, “Jack”, “Queen”, “King”)

Cells(i, 1).Value = SuitText(SuitNo)
Cells(i, 2).Value = CardText(CardNo)

Next CardNo

Next SuitNo

End Sub

Reply | Quote

Nice one, Jerry. I like it.

Reply | Quote