Consulting

Results 1 to 1 of 1

Thread: Sleeper: VBA TextBoxes Yahtzee

  1. #1
    VBAX Regular
    Joined
    May 2004
    Location
    Sweden
    Posts
    21
    Location

    Sleeper: VBA TextBoxes Yahtzee

    Hi All

    Ive posted a question of how to sum scores in an old Yahtzee i made sometime ago over at MrExcel: http://www.mrexcel.com/board2/viewto...=462469#462469

    The code i work with for now:

    Private Sub CommandButton1_Click() 
    Dim DiceVals As String, Die1 As Integer, Die2 As Integer, Die3 As Integer, Die4 As Integer 
    Dim Die5 As Integer, Die6 As Integer 
    'Roll ye olde dice 
    Call DiceRoll 
    'Create an array (of sorts) holding the dice values 
    DiceVals = "{" & txtDice1 & "," & txtDice2 & "," & txtDice3 & "," & txtDice4 & "," & txtDice5 & txtDice6 & "}" 
    'Determine total of each die 
    Die1 = Evaluate("SUM(IF(" & DiceVals & "=1,1,0))") 
    Die2 = Evaluate("SUM(IF(" & DiceVals & "=2,1,0))") 
    Die3 = Evaluate("SUM(IF(" & DiceVals & "=3,1,0))") 
    Die4 = Evaluate("SUM(IF(" & DiceVals & "=4,1,0))") 
    Die5 = Evaluate("SUM(IF(" & DiceVals & "=5,1,0))") 
    Die6 = Evaluate("SUM(IF(" & DiceVals & "=6,1,0))") 
    'Total of single values 1 to 6 multiplied by its die number 
    txtOne = Die1 
    txtTwo = Die2 * 2 
    txtThree = Die3 * 3 
    txtFour = Die4 * 4 
    txtFive = Die5 * 5 
    txtSix = Die6 * 6 
    'Total for 3 of a Kind. If 3 or more dice are the same then total all 5 dice 
    If Evaluate("MAX(FREQUENCY(" & DiceVals & ",{1,2,3,4,5,6}))") >= 3 Then 
        txt3ofakind = Evaluate("Sum(" & DiceVals & ")") 
    Else 
        txt3ofakind = 0 
    End If 
    'Total for 4 of a Kind. If 4 or more dice are the same then total all 5 dice 
    If Evaluate("MAX(FREQUENCY(" & DiceVals & ",{1,2,3,4,5,6}))") >= 4 Then 
        txt4ofakind = Evaluate("Sum(" & DiceVals & ")") 
    Else 
        txt4ofakind = 0 
    End If 
    'Total for a Full House 
    If Evaluate("MAX(FREQUENCY(" & DiceVals & ",{1,2,3,4,5,6}))") = 3 Then 
        If Die1 = 2 Or Die2 = 2 Or Die3 = 2 Or Die4 = 2 Or Die5 = 2 Or Die6 = 2 Then 
            txtFullHouse = 25 
        Else 
            txtFullHouse = 0 
        End If 
    Else 
        txtFullHouse = 0 
    End If 
    'Total of Small Straight. Any 4 dice in sequence. eg 1,2,3,4 or 3,4,5,6 etc 
    If Die1 > 0 And Die2 > 0 And Die3 > 0 And Die4 > 0 Or _ 
    Die2 > 0 And Die3 > 0 And Die4 > 0 And Die5 > 0 Or _ 
    Die3 > 0 And Die4 > 0 And Die5 > 0 And Die6 > 0 Then 
        txtSmallStraight = 30 
    Else 
        txtSmallStraight = 0 
    End If 
    'Total of Large Straight. Any 5 dice in sequence. eg 1,2,3,4,5 or 2,3,4,5,6 
    If Die1 > 0 And Die2 > 0 And Die3 > 0 And Die4 > 0 And Die5 > 0 Or _ 
        Die2 > 0 And Die3 > 0 And Die4 > 0 And Die5 > 0 And Die6 > 0 Then 
        txtLargeStraight = 40 
    Else 
        txtLargeStraight = 0 
    End If 
    'Total for Chance 
    txtChance = Evaluate("Sum(" & DiceVals & ")") 
    'Total for Yahtzee 
    If Evaluate("MAX(FREQUENCY(" & DiceVals & ",{1,2,3,4,5,6}))") = 5 Then 
        txtYahtzee = 50 
    Else 
        txtYahtzee = 0 
    End If 
    End Sub 
    
    Sub DiceRoll() 
    'You would need to change this to account for holding dice 
    txtDice1 = Int(6 * Rnd + 1) 
    txtDice2 = Int(6 * Rnd + 1) 
    txtDice3 = Int(6 * Rnd + 1) 
    txtDice4 = Int(6 * Rnd + 1) 
    txtDice5 = Int(6 * Rnd + 1) 
    End Sub
    Full credit for the code above goes to Parry!

    What i'm trying to achieve is:

    Sum txtDice 1 to 6 for Pairs, 3-4-5-of a Kind, Small Straight, Large Straight, Full Straight, House, Full House & Tower.

    These are the Rules and Points
    Points given are always the sum of the dice that counts as a match. This works fine for One, Two, Three etc.

    One pair: 2 equals. Points: Sum of your pair. With 6 dice's it could of course be 3 pairs and therefor the highest pair are the one to sum.
    Ex: One pair could be 1+1 = 2, 2+2 = 4. This could set you up with: 1+1+2+2+5+5 (3pairs) where 5+5=10 is the pair to sum (highest pair).

    Two pairs: 2 + 2 equals. Points: Sum of the 2 pairs. With 6 dice's it could of course be 3 pairs and therefor the highest 2 are the pairs to sum.
    Ex: Two pairs could be 1+1+2+2 =6 . This could set you up with: 1+1+2+2+5+5 (3pairs) where 5+5 & 2+2 = 14 are the pair to sum (highest pairs).

    Three pairs: 2 + 2 + 2 equals. Points: Sum of all 3 pairs = sum all dice's.
    Ex: 1+1+3+3+6+6=20

    Three Of A kind: 3 equals. Points: Sum of your 3 equals. With 6 dice's it could of course be 2 sets of 3 equals and the sum of the 3 dice's in the highest set = Sum.
    Ex: 1+1+1+2+3+4=3 1+1+1+4+4+4=12 (highest set of 3 of a kind)
    Works except for summing the points and chosing the highest set of 3

    Four Of A kind: 4 equals. Points: Sum of your 4 equals.
    Ex: 2+2+2+2+1+5=8
    Works except for summing the points

    Five Of A kind: 5 equals. Points: Sum of your 5 equals.
    Ex: 2+2+2+2+2+5=10
    Works except for summing the points

    Small Straight: 1-2-3-4-5. Points: Sum of 1-2-3-4-5 = 15
    Since this always sums up = 15 there's no need to calculate the sum.

    Large Straight: 2-3-4-5-6. Points: Sum of 2-3-4-5-6 = 20
    Since this always sums up = 20 there's no need to calculate the sum.

    Full Straight: 1-2-3-4-5-6. Points: Sum of 1-2-3-4-5-6 = 21
    Since this always sums up = 21 there's no need to calculate the sum.
    Works

    House: 3 equals + 2 equals. Points: Sum of the 3 + 2 equals.
    Ex: 1+1+1+2+2+4=7 Could be 1+1+1+2+2+2= 8 (3*2 highest 3 & 2*1)

    Full House: 3 equals + 3 equals. Points: Sum of the 3 + 3 equals = demands that all dice's match = sum all dice's. Must be to different set fo equals with different value's.
    Ex: 1+1+1+2+2+2=9 allowed 1+1+1+1+1+1 = Not allowed

    Tower: 4 equals + 2 equals. Points: Sum of the 4 + 2 equals = demands that all dice's match = sum all dice's.
    Ex:1+1+1+1+2+2=8 Works

    Chance: Points: Sum all dice's. Works

    Yatzy: Points: 100. Works

    All suggestions are more than welcome!

    /Roger
    Last edited by Aussiebear; 04-29-2023 at 07:14 PM. Reason: Adjusted the code tags

Posting Permissions

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