VBA dice roll with addition

Question

VBA dice roll is very easy thing even for me, but I need specific type, when rolling 6 means you can roll again and add the two rolls together (plus when you roll 6 twice in a row, you get third roll and so on).

I have tried two approaches, but both failed

Sub roll_dice_1()

Dim result As Range

Set result = Range("A1")

result = Application.WorksheetFunction.RandBetween(1, 6)

If result = 6 Then
  result = result + Application.WorksheetFunction.RandBetween(1, 6)
  Do Until Application.WorksheetFunction.RandBetween(1, 6) <> 6
  result = result + Application.WorksheetFunction.RandBetween(1, 6)
  Loop
   Else
End If

End Sub

This one however can produce result of 12, which is clearly impossible, because twice 6 should give third roll

Sub roll_dice_2()

Dim result As Range

Set result = Range("A1")

result = Application.WorksheetFunction.RandBetween(1, 6)

If result = 6 Then
  Do Until Application.WorksheetFunction.RandBetween(1, 6) <> 6
  result = result + Application.WorksheetFunction.RandBetween(1, 6)
  Loop
   Else
End If

End Sub

This one works even worse, because it can return 6.

I tried search high and low, but all that I got were simple codes for simple throws, rolls with two dices and rolls when certain results can be rerolled. Again all options pretty easy, unlike this one

Tom · Accepted Answer · 2017-10-13T11:11:16.617

1

Your issue is you're generating a random number to test against and then generating a different one to add to your result. They need to be the same. Also VBA has it's own random function.

Sub roll_dice()
    Dim result As Integer, roll as Integer
    Dim lowerbound As Integer, upperbound As Integer

    lowerbound = 1
    upperbound = 6

    result = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

    If result = upperbound Then
        roll = result
        Do While roll = upperbound
          roll = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
          result = result + roll
        Loop
    End If

    MsgBox result
End Sub

edited Oct 13 '17 at 11:11

answered Oct 13 '17 at 09:47

Tom

9,725
3
31
48

Thanks, I knew that the loop mistake would be something like this, but I was out of ideas how to make it work – telesien Oct 13 '17 at 11:03
1

BTW is there any reason why you declare result and roll as long, when integer should be enough? – telesien Oct 13 '17 at 11:06
Probably poor habit in this case. I'm used to using it to avoid overflow errors, however you aren't going to risk that issue in this case. So you're right. Have corrected – Tom Oct 13 '17 at 11:10
3

@telesien In modern systems using `Long` can actually be faster. See [this post from RubberDuck](https://stackoverflow.com/a/26409520/5994620) explaining it. – BerticusMaximus Oct 13 '17 at 13:23
@BerticusMaximus Thanks - knew there was another reason but couldn't remember for the life of me – Tom Oct 13 '17 at 14:11

score 0 · Answer 2 · answered Oct 13 '17 at 09:47

The loop is wrong. You cannot roll in the condition and then roll again to accumulate as these are already 2 rolls.

Basically what you need is a loop where the condition comes last, e.g.

Result = 0 Do Roll =... Result = result + roll Loop while roll <> 6

score 0 · Answer 3 · edited Aug 25 '20 at 04:58

0

Seems the issue if the handling of 6, if it is to thow reroll, then you should implement:

... roll = 6

do while roll = 6
 roll = Int(( 6 * Rnd + 1)
 ShowRoll(roll)
loop

DoStuffWithRollValue

...

this will show every roll until row is 1-5 ShowRoll is the call to the animation or other method of showing the roll

edited Aug 25 '20 at 04:58

U3.1415926

812
12
30

answered Aug 24 '20 at 03:37

BAP

21
1

score 0 · Answer 4 · edited Mar 16 '21 at 22:24

0

Sub roll_dice()
    Dim die1, die2 As Integer
    
    'Randomize
    die1 = (Hour(Rnd) Mod 6) + 1
    die2 = (Hour(Rnd) Mod 6) + 1
Exit Sub

edited Mar 16 '21 at 22:24

answered Mar 16 '21 at 21:30

user15410869

1

Please don't post only code as answer, but also provide an explanation what your code does and how it solves the problem of the question. Answers with an explanation are usually more helpful and of better quality, and are more likely to attract upvotes. – Mark Rotteveel Mar 19 '21 at 13:56

VBA dice roll with addition

4 Answers4