Results 1 to 5 of 5
  1. #1
    4 Star Lounger
    Join Date
    Sep 2002
    Location
    Stafford, Staffordshire, England
    Posts
    585
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Dealing Cards (XP)

    <img src=/S/hello.gif border=0 alt=hello width=25 height=29>

    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
    <font color=blue><font face="Script MT Bold"><big>Rob</big></font face=script></font color=blue>

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Dealing Cards (XP)

    See attached text file.
    Attached Files Attached Files

  3. #3
    4 Star Lounger
    Join Date
    Sep 2002
    Location
    Stafford, Staffordshire, England
    Posts
    585
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Dealing Cards (XP)

    Many thanks again, Hans.
    <font color=blue><font face="Script MT Bold"><big>Rob</big></font face=script></font color=blue>

  4. #4
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Dealing Cards (XP)

    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
    Jerry

  5. #5
    4 Star Lounger
    Join Date
    Sep 2002
    Location
    Stafford, Staffordshire, England
    Posts
    585
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Dealing Cards (XP)

    Nice one, Jerry. I like it. <img src=/S/thumbup.gif border=0 alt=thumbup width=15 height=15>
    <font color=blue><font face="Script MT Bold"><big>Rob</big></font face=script></font color=blue>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •