Chi-Square Critical Values in Visual Basic

I didn't find any code for calculating critical values für Chi-Square test.

This link has the formulas:
http://elib.zib.de/netlib/a/perlman

Here are the estimated results
http://www.statsoft.com/textbook/sttable.html#chi

but I must have missed something.
Perhaps because constants are to small??
-->LOG_SQRT_PI
-->I_SQRT_PI

Pls check
?critchi(0.95,1)  -->3,93189812455577E-03  --> OK
?critchi(0.95,2) -->0,102586974422356 --OK
?critchi(0.95,3) --> looping around


btw: I do not understand, why
bolEven = (2 * (df / 2)) = df
shoud result in even/uneven

This is my Code which I also post as MS Excel-Macro Project

Const Z_MAX As Long = 6 'maximum meaningful z value
Const CHI_MAX As Long = 99999
Const CHI_EPSILON As Double = 0.000001
Const BIGX As Double = 20
Const LOG_SQRT_PI As Double = 0.5723649429247                '0.5723649429247000870717135 /* log(sqrt(pi)) */
Const I_SQRT_PI As Double = 0.564189583547756                '0.5641895835477562869480795 /* 1 / sqrt(pi) */
 
 
Function CritChi(p As Double, df As Integer) As Double
'FUNCTION critchi: compute critical chi square value to produce given p
 
    Dim MinChisq As Double
    Dim MaxChisq As Double
    Dim ChiSqval As Double
    
    MinChisq = 0
    MaxChisq = CHI_MAX
    
    If p <= 0 Then
        CritChi = CHI_MAX
        Exit Function
    ElseIf p > 1 Then
        CritChi = 0
        Exit Function
    End If
    
    
    ChiSqval = df / VBA.Math.Sqr(p) 'fair first value
    
    
    Do While (MaxChisq - MinChisq > CHI_EPSILON)
        If (pochisq(ChiSqval, df) < p) Then
            MaxChisq = ChiSqval
        Else
            MinChisq = ChiSqval
        End If
        ChiSqval = (MaxChisq + MinChisq) * 0.5
    Loop
    
    CritChi = ChiSqval
 
End Function
 
Function pochisq(x As Double, df As Integer)
'x=obtained chi-square value
'df=degrees of freedom
'    X   double  poz ();   /* computes probability of normal z score */
'    X   int     even;     /* true if df is an even number */
'    x
    Dim a As Double
    Dim y As Double
    Dim s As Double
    Dim e As Double
    Dim c As Double
    Dim z As Double
 
    Dim bolEven As Double
    
    If (x <= 0 Or df < 1) Then
        pochisq = 1
        Exit Function
    End If
    
    a = 0.5 * x
    'bolEven = (2 * (df / 2)) = df
    If df Mod 2 = 0 Then
        bolEven = True
    Else
        bolEven = False
    End If
    
    If df > 1 Then y = ex(-a)
    
    If bolEven Then
        s = y
    Else
        s = 2 * poz(-VBA.Math.Sqr(x))
    End If
    
    If df > 2 Then
        x = 0.5 * df - 1
        If bolEven Then
            z = 1
        Else
            z = 0.5
        End If
        
        If a > BIGX Then
            If bolEven Then
                e = 0
            Else
                e = LOG_SQRT_PI
            End If
            
            c = Log(a)
            
            Do While z <= x
                e = Log(z) + e
                s = s + ex(c * z - a - e)
                z = z + 1
            Loop
            
            pochisq = s
            Exit Function
        Else
            
            If bolEven Then
                e = 1
            Else
                e = I_SQRT_PI / VBA.Math.Sqr(a)
            End If
            
            c = 0
            
            Do While z <= x
                e = e * (a / z)
                c = c + e
                z = z + 1
            Loop
            
            pochisq = (c * y + s)
            Exit Function
        End If
    Else
        pochisq = s
    End If
            
End Function
 
 
Function poz(z As Double) As Double
'VAR returns cumulative probability from -oo to z
'*ALGORITHM
'   Adapted from a polynomial approximation in:
'       Ibbetson D, Algorithm 209
'       Collected Algorithms of the CACM 1963 p. 616
' Note:
'       This routine has six digit accuracy, so it is only useful for absolute
'       z values < 6.  For z values >= to 6.0, poz() returns 0.0.
'z=VAR normal z value
 
Dim y As Double
Dim x As Double
Dim w As Double
 
    If z = 0 Then
        x = 0
    Else
        y = 0.5 * Math.Abs(z)
        If (y >= (Z_MAX * 0.5)) Then
            x = 1
        ElseIf y < 1 Then
            w = y * y
            x = ((((((((0.000124818987 * w _
                - 0.001075204047) * w + 0.005198775019) * w _
                - 0.019198292004) * w + 0.059054035642) * w _
                - 0.151968751364) * w + 0.319152932694) * w _
                - 0.5319230073) * w + 0.797884560593) * y * 2
        Else
                   y = y - 2
                   x = (((((((((((((-0.000045255659 * y _
                       + 0.00015252929) * y - 0.000019538132) * y _
                       - 0.000676904986) * y + 0.001390604284) * y _
                       - 0.00079462082) * y - 0.002034254874) * y _
                       + 0.006549791214) * y - 0.010557625006) * y _
                       + 0.011630447319) * y - 0.009279453341) * y _
                       + 0.005353579108) * y - 0.002141268741) * y _
                       + 0.000535310849) * y + 0.999936657524
        End If
    End If
 
    If z > 0 Then
        poz = (x + 1) * 0.5
    Else
        poz = ((1 - x) * 0.5)
    End If
 
End Function
 
Function ex(x) As Double
    If x < -BIGX Then
        ex = 0
    Else
        ex = VBA.Math.Exp(x)
    End If
End Function

Select allOpen in new window

ChiSquare.xls