Random Number Macro

[Nick]

hi everyone

what i need is a macro which takes a random number from
Cell B2 and puts only the value in Cell B5. I have made
it so that the random numbers can only be between 2 and 12
and they are weighted on a distribution.

then, if the value in Cell B5 is a 2, 3 or 12 then stop
the stream and place a "Lose" in Cell C5, if the value in
Cell B5 is a 7 or 11 then place a "Win" in Cell C5. if
the value in Cell B5 is any other number (i.e. 4, 5, 6, 8,
9 or 10) then recalculate the random number and the value
only in Cell B6.

i then want the stream to continue of re-calculating the
random number and placing it one cell down, i.e., then B7,
then B8, then B9 and so on. once the stream of numbers in
a row is more than one then the stream only stops in two
cases (a) when the last number in the stream is the same
as the value in Cell B5, or (b) when the last number is a
7.

in the case of (a) i need a "Win" in the cell in column C
next to where the stream stops, in the case of (b) i need
a "Lose" in the cell in column C next to where the stream
stops.

is this possible with a macro?

 

[beeawwb]

I'll take a look if I get some free time. Just finished lunch. Hope
can help.

-Bo

 

[Nick]

Bob

If you can help I would be very grateful!

Cheers
Nick

 

[beeawwb]

Halfway done writing the code, it's working so far.

Just to check, this is kind of like a game of craps, as far as I know?
You've got a number between 2 and 12 (2 dice), and winning on 7 or 11,
crapping out with snake eyes, etc. I've never played craps, but it
seems like that's what this is, from the references I know. Cool stuff
if it is.

-Bob

 

[Nick]

Hi Bob

Exactly... it is to replicate a game of craps, i don't
understand VB commands enough to do it myself, but know it
could be done!

I would be happy to explain some of the rules if you would
like?

 

[beeawwb]

Send an email to me at

(e-mail address removed) with the subject Excel Craps Game

if you'd like. This is pretty similar to a project my friend and I
worked on in Year 12 in JavaScript where we make a game of Black Jack,
and when I made an Excel version of "Petals Around The Rose"

I'm just taking a quick break at the moment, then have to go back to my
real job (I check the forums in the slow moments). Just as an FYI on my
progress, the dice roll, and it goes through the first series of
checks, and moves on to the second series. Will get on to that either
later today, or sometime tomorrow morning. Shouldn't take me very
long.

Happy to help. Much fun.

-Bob

 

[beeawwb]

Bingo. As far as I can tell, this works great. There were a few
debugging problems, but I got through them. Paste this into a new
module.




Dim cellvalue

Sub Craps()
Setup:
Application.ScreenUpdating = True
[B5] = [B2]

Rollem:
If (([B5] = 2) Or ([B5] = 3) Or ([B5] = 12)) Then GoTo CrapOut
If (([B5] = 7) Or ([B5] = 11)) Then GoTo FirstLucky
cellvalue = 0
GoTo NotWinner
End

NotWinner:
Application.ScreenUpdating = True
Application.Calculate
Repeater:
cellvalue = cellvalue + 1
Worksheets("Sheet1").Cells(cellvalue + 5, 2).Value = [Sheet1!B2]
If ([B2] = "7") Then GoTo SevenLose
If ([B2] = [B5]) Then GoTo Winner
GoTo LoopAround
End

LoopAround:
GoTo Repeater
End

Winner:
Worksheets("Sheet1").Cells(cellvalue + 5, 2).Value = [B2]
Worksheets("Sheet1").Cells(cellvalue + 5, 3).Value = "Win"
Beep
Beep
Beep
Application.ScreenUpdating = True
End

SevenLose:
Worksheets("Sheet1").Cells(cellvalue + 5, 3).Value = "Lose 1"
Application.ScreenUpdating = True
End

FirstLucky:
[C5] = "Win"
Beep
Beep
Beep
End

CrapOut:
[C5] = "Lose 2"

End Sub


Hope that helps, will talk to you about it later. Almost time to go
home.

-Bob

 

[beeawwb]

Oh yeah, one final thing.

I didn't make anything to clear the list. I was just doing it manually.
A bit harder because of the random nature of how it all works, but I
*think* it could be done at the start of the (for lack of a better
word) 'program' in where it would take the previous cellvalue and
delete everything in B and C down to that number. I might try it out
later, but don't have the time right now.

-Bob

 

[Tushar Mehta]

Not that responding to this guarantees a satisfactory resolution to
your problem...

If Bob's solution doesn't do the trick and you still need help, you
need to explain (1) *all* applicable rules for generating the win/lose
decision, and (2) how you generate the random number in B2 'weighted on
a distribution.'

--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Nick]

Hi Bob,

Thanks for the code, but it doesn't seem to work exactly
as the rules require...

I gave it a test run and for some reason it doesn't work
all the time. Eg. i just ran it and it came up with
8
8
3
6 Lose 1

which should actually continue the chain because you can't
lose on a 6!

just to repeat the rules
a) First Spin Only - you lose on 2, 3 or 12 and win on 7
or 11
b) Any other number continues the chain (i.e. 4, 5, 6, 8,
9 or 10)
c) The only way to then win is to get the same number as
your first spin that continues the chain (i.e. 4, 5, 6, 8,
9 or 10)
d) The only way to lose is to get a 7 before the same
number as your first spin comes up
e) Otherwise the chain just continues until you win or
lose...

Some examples to make it clearer.
Eg.1) 8 (therefore continue) 4, 5, 5, 10, 2, 8 = Win
Eg.2) 5 (therefore continue) 4, 6, 12, 12, 7 = Lose
Eg.3) 3 (therefore stop) = Lose
Eg.4) 11 (therefore stop) = Win
Eg.5) 6 (therefore continue) 2, 2, 5, 11, 6 = Win
Eg.6) 10 (therefore continue) 6, 6, 2, 3, 3, 7 = Lose

Can you see where the error might be?

Please email me at (e-mail address removed)

With thanks
Nick

 

[beeawwb]

Nick, I've fixed the problem (it was a problem I had to fix with winnin
when I was writing it, but didn't catch it on losing) I'll email yo
when I get home, can't access hotmail from work.

-Bo

 

[Tushar Mehta]

8
8
3
6 Lose 1

which should actually continue the chain because you can't
lose on a 6!

c) The only way to then win is to get the same number as
your first spin that continues the chain (i.e. 4, 5, 6, 8,
9 or 10)

According to rule c shouldn't the 2nd 8 result in a win?

--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

Hi Bob,

Thanks for the code, but it doesn't seem to work exactly
as the rules require...

I gave it a test run and for some reason it doesn't work
all the time. Eg. i just ran it and it came up with
8
8
3
6 Lose 1

which should actually continue the chain because you can't
lose on a 6!

just to repeat the rules
a) First Spin Only - you lose on 2, 3 or 12 and win on 7
or 11
b) Any other number continues the chain (i.e. 4, 5, 6, 8,
9 or 10)
c) The only way to then win is to get the same number as
your first spin that continues the chain (i.e. 4, 5, 6, 8,
9 or 10)
d) The only way to lose is to get a 7 before the same
number as your first spin comes up
e) Otherwise the chain just continues until you win or
lose...

Some examples to make it clearer.
Eg.1) 8 (therefore continue) 4, 5, 5, 10, 2, 8 = Win
Eg.2) 5 (therefore continue) 4, 6, 12, 12, 7 = Lose
Eg.3) 3 (therefore stop) = Lose
Eg.4) 11 (therefore stop) = Win
Eg.5) 6 (therefore continue) 2, 2, 5, 11, 6 = Win
Eg.6) 10 (therefore continue) 6, 6, 2, 3, 3, 7 = Lose

Can you see where the error might be?

Please email me at (e-mail address removed)

With thanks
Nick

-----Original Message-----
Bingo. As far as I can tell, this works great. There were a few
debugging problems, but I got through them. Paste this into a new
module.




Dim cellvalue

Sub Craps()
Setup:
Application.ScreenUpdating = True
[B5] = [B2]

Rollem:
If (([B5] = 2) Or ([B5] = 3) Or ([B5] = 12)) Then GoTo CrapOut
If (([B5] = 7) Or ([B5] = 11)) Then GoTo FirstLucky
cellvalue = 0
GoTo NotWinner
End

NotWinner:
Application.ScreenUpdating = True
Application.Calculate
Repeater:
cellvalue = cellvalue + 1
Worksheets("Sheet1").Cells(cellvalue + 5, 2).Value = [Sheet1!B2]
If ([B2] = "7") Then GoTo SevenLose
If ([B2] = [B5]) Then GoTo Winner
GoTo LoopAround
End

LoopAround:
GoTo Repeater
End

Winner:
Worksheets("Sheet1").Cells(cellvalue + 5, 2).Value = [B2]
Worksheets("Sheet1").Cells(cellvalue + 5, 3).Value = "Win"
Beep
Beep
Beep
Application.ScreenUpdating = True
End

SevenLose:
Worksheets("Sheet1").Cells(cellvalue + 5, 3).Value = "Lose 1"
Application.ScreenUpdating = True
End

FirstLucky:
[C5] = "Win"
Beep
Beep
Beep
End

CrapOut:
[C5] = "Lose 2"

End Sub


Hope that helps, will talk to you about it later. Almost time to go
home.

-Bob