VBA Help Identifying Logic Error

mudz78

New Member
Joined
Jun 4, 2004
Messages
38
Hi,

I am trying to write a little application that calculates the odds of getting a user defined result (or greater) on a user defined number of dice with user defined number of sides.

Example:

"What is the chance of rolling a five or a six three times or more, when rolling 5d6?"

The code below is what I have come up with, but I seem to get an unexpected result when I use values as in the example.

The correct result would be 0.002743484

What I get is 0.041152263.

A more complete overview of the results scenario can be found:
http://www.staff.ncl.ac.uk/nikolas.lloyd/wargames/crossfire/cfdiceeg.html. Many thanks to the site authour for the mathematical explanation.


I realise that my code is more than likely not optimised and that I have probably overstated the data types (hey, it stopped the ByRef Type mismatch errors), but I am a bit of a novice user.

Any advice would be greatly appreciated.

Thanks,
-John



Code:
Option Explicit
Dim n, x, p, r As Double

Private Sub cmdCalculate_Click()
'Reset Variables

'hold the factorial result
    f = 0
'number of dice being rolled
    n = 0
'probability of success on a single die
    p = 0
'minimum value required on a dice
    r = 0
'numbr of sides on a die
    s = 0
'number of successes required to meet (r) where x<=n
    x = 0
'Start Calculations
    All
End Sub

Private Sub All()
'store cumualtive calculation of odds
Dim result As Double

'Fetch User inputs
    n = CDbl((frmDice.txtTotalDice.Value))
    r = CDbl(frmDice.txtRequiredRoll.Value)
    s = CDbl(frmDice.txtDiceSize.Value)
    x = CDbl((frmDice.txtHits.Value))
    
'calculate odds of success on a single die
    p = CDbl((((d - r) + 1) / d))
    
'Loop, summing odds of desired results. Rolling 5 dice with
'_at least_ three favourable results required means summing
' odds of 3 results, 4 results and 5 results.
'Remember, n is the number of dice (ie 5) and x is the number of successes

    Do While x <= n
        result = result + Individual(n, x, p)
        x = x + 1
    Loop
'Display Result on Form
frmDice.txtResult.Text = 100 * r & " %"
End Sub

Public Function Individual(n, x, p)
'Calculate the odds of acheiving (x) successes rolling (n) dice given single
'die probabiltiy of (p).
'THanks to 
    f = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _
    * (p ^ x) * ((1 - p) ^ (n - x))
End Function

Function Factorial(ByVal x As Double) As Double
  'perform required factorial calculation
    Dim i As Integer
    Factorial = 1
    
    For i = 1 To x
        Factorial = Factorial * i
    Next i
End Function
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Tazguy37

MrExcel MVP
Joined
May 28, 2004
Messages
4,237
Shouldn't this:
Rich (BB code):
Public Function Individual(n, x, p) 
'Calculate the odds of acheiving (x) successes rolling (n) dice given single 
'die probabiltiy of (p). 
'THanks to 
    f = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _ 
    * (p ^ x) * ((1 - p) ^ (n - x)) 
End Function
be:
Rich (BB code):
Public Function Individual(n, x, p) 
'Calculate the odds of acheiving (x) successes rolling (n) dice given single 
'die probabiltiy of (p). 
'THanks to 
    Individual = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _ 
    * (p ^ x) * ((1 - p) ^ (n - x)) 
End Function
 

mudz78

New Member
Joined
Jun 4, 2004
Messages
38
Yep, it should. Thanks.

I have never really used functions before, didn't realise quite how they worked. I also noticed, that making changes to your code in the post and then not testing those changes is a baaad idea.

Fixed all the stupid errors and have ended up with:

Code:
Option Explicit
Dim n, x, p, r, s As Double

Private Sub cmdCalculate_Click()
'Reset Variables

'number of dice being rolled
    n = 0
'probability of success on a single die
    p = 0
'minimum value required on a dice
    r = 0
'number of sides on a die
    s = 0
'number of successes required to meet (r) where x<=n
    x = 0
'Start Calculations
    All
End Sub

Private Sub All()
'store cumualtive calculation of odds
Dim result As Double

'Fetch User inputs
    n = CDbl((frmDice.txtTotalDice.Value))
    r = CDbl(frmDice.txtRequiredRoll.Value)
    s = CDbl(frmDice.txtDiceSize.Value)
    x = CDbl((frmDice.txtHits.Value))
    
'calculate odds of success on a single die
    p = CDbl((((s - r) + 1) / s))

'Loop, summing odds of desired results. Rolling 5 dice with
'_at least_ three favourable results required means summing
' odds of 3 results, 4 results and 5 results.
'Remember, n is the number of dice (ie 5) and x is the number of successes

    Do While x <= n
        result = result + Individual(n, x, p)
        x = x + 1
    Loop
    
'Display Result on Form
frmDice.txtResult.Text = Round(100 * result, 2) & " %"
End Sub

Public Function Individual(n, x, p)
'Calculate the odds of acheiving (x) successes rolling (n) dice given single
'die probabiltiy of (p)
    Individual = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _
    * (p ^ x) * ((1 - p) ^ (n - x))
End Function

Function Factorial(ByVal x As Double) As Double
  'perform required factorial calculation
    Dim i As Integer
    Factorial = 1
    
    For i = 1 To x
        Factorial = Factorial * i
    Next i
End Function

Still not perfect. My end result is out by a fraction of a percent using the example.

Any suggestions?

Cheers,
-John
 

Tazguy37

MrExcel MVP
Joined
May 28, 2004
Messages
4,237
Post a sheet sample, and we'll have a look. Post expected results as well as actual.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,625
Messages
5,832,750
Members
430,163
Latest member
YesImAk

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top