1

I am working an MS Access application a part of which uses Beta Distribution function. Since MS Access does not have Beta Distribution function of its own I'm using calling BetaDist function from MS Excel. I've tested the code in MS Excel and it seems to run successfully. In MS Access also the code is working fine and generating correct results but the time taken by Access is very high than the time taken by Excel. I'm posting the part of code which utilizes BetaDist function and also the slowest portion of the code. I want to reduce the time taken by Access. Any help is appreciated.

Part of Code which utilizes BetaDist:

    For i = 1 To UBound(arrBetaParam)
       If arrBetaParam(i).Alpha <= 0 Or arrBetaParam(i).Beta <= 0 Or tryOutValue > arrBetaParam(i).ExpValue Then
        dblTempEP = 0
       Else
            If tryOutValue > arrBetaParam(i).LastKnownGoodValue Then
                dblTempEP = 0
            Else
                dblTempEP = 1
            End If
            Dim bt As Double
            bt = -1
            On Error Resume Next
            bt = Excel.WorksheetFunction.BetaDist(tryOutValue, arrBetaParam(i).Alpha, arrBetaParam(i).Beta, 0, arrBetaParam(i).ExpValue)
            tj = bt
            If bt > -1 Then
                If bt > 1 Then bt = 1
                If bt < 0 Then bt = 0
                arrBetaParam(i).LastKnownGoodValue = tryOutValue
                dblTempEP = 1 - bt
            End If
            On Error GoTo 0
        End If

        OEP = OEP + dblTempEP * arrBetaParam(i).Rate
        'sumRate = sumRate + arrBetaParam(i).Rate
    Next
4
  • 1
    Your code has to start Excel which is probably why it takes so long. You'll also be left with an orphaned excel.exe process running doing it that way. Commented Jun 18, 2015 at 10:17
  • Yes. But will it start and close excel for every iteration? Commented Jun 18, 2015 at 10:23
  • Hard to say - I would never use an implicit reference like that. You should create your own instance and use that, or write/find your own BetaDist function. Commented Jun 18, 2015 at 10:57
  • Sprinkle some, debug.print "x" & time, lines into your code to see which part exactly is taking the longest time... you can take it from there. Commented Jun 19, 2015 at 8:33

2 Answers 2

2

Your code is probably taking so long due to the fact it has to open the Excel application.

BetaDist is not complicated to implement. Why not create a VBA function in Acces VBA. Here is the formula:

f(x) = B(alpha,beta)-1 xalpha-1(1-x)beta-1

Here I found a decent implementation. Didn't test it though:

Option Explicit

Const n             As Long = 200    ' increase for accuracy, decrease for speed

Public aa           As Double
Public bb           As Double

Function BetaDist1(x As Double, a As Double, b As Double)
    Dim d1          As Double
    Dim d2          As Double
    Dim n1          As Long
    Dim n2          As Long

    aa = a
    bb = b
    n1 = x * n
    n2 = n - n1

    d1 = SimpsonInt(0, x, n1)
    d2 = SimpsonInt(x, 1, n2)
    BetaDist1 = d1 / (d1 + d2)
End Function

Function SimpsonInt(ti As Double, tf As Double, ByVal n As Long) As Double
    ' shg 2006

    ' Returns the integral of Func (below) from ti to tf _
      using Composite Simpson's Rule over n intervals
    Dim i           As Double  ' index
    Dim dH          As Double  ' step size
    Dim dOdd        As Double  ' sum of Func(i), i = 1, 3, 5, 7, ... n-1, i.e., n/2 values
    Dim dEvn        As Double  ' sum of Func(i), i =   2, 4, 6,  ... n-2  i.e., n/2 - 1 values
    ' 1 + (n/2) + (n/2 - 1) + 1 = n+1 function evaluations

    If n < 1 Then Exit Function

    If n And 1 Then n = n + 1    ' n must be even
    dH = (tf - ti) / n

    For i = 1 To n - 1 Step 2
        dOdd = dOdd + Func(ti + i * dH)
    Next i

    For i = 2 To n - 2 Step 2
        dEvn = dEvn + Func(ti + i * dH)
    Next i

    SimpsonInt = (Func(ti) + 4# * dOdd + 2# * dEvn + Func(tf)) * dH / 3#    ' weighted sum
End Function

Function Func(t As Double) As Double
    Func = t ^ (aa - 1) * (1 - t) ^ (bb - 1)
End Function
Sign up to request clarification or add additional context in comments.

Comments

1

You could do like this:

Dim xls As Excel.Application    
Set xls = New Excel.Application

' Begin loop.
    bt = xls.WorksheetFunction.BetaDist(tryOutValue, arrBetaParam(i).Alpha, arrBetaParam(i).Beta, 0, arrBetaParam(i).ExpValue)
' End loop.  

xls.Quit
Set xls = Nothing

1 Comment

Gustav, Thanks for your solution. But I have implemented BetaDist function in my code as suggested by @AnalystCave.com. Hence, selected his solution.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.