Attribute VB_Name = "Module101"
'BASE MODULE 3
Option Explicit
Option Base 1
Const BLX = -307.652655568588
Const Pupper = 1.000000000001


Public Function NewOne(u As Range, itype)
'Uses Welford's algorithm
Dim ax As Variant
Dim nxrows, nxcols As Integer
Dim a1, A0, ss0, ss1, x, c, var, sd As Double
Dim cc1, cc2, y1, z As Double
Dim i, j, k, flag As Integer

flag = itype
If flag = 0 Or flag > 5 Then
    NewOne = 0
    Exit Function
ElseIf IsEmpty(itype) Then
    NewOne = 0
    Exit Function
End If

nxrows = u.Rows.count
nxcols = u.Columns.count
ax = u.value
If IsEmpty(ax(1, 1)) Then
    NewOne = 0
    Exit Function
End If
A0 = ax(1, 1)
ss0 = 0#
cc1 = 0#
cc2 = 0#
k = 0
If nxcols = 1 Then
    For i = 2 To nxrows
        c = CDbl(i)
        If Not IsEmpty(ax(i, 1)) Then
            x = ax(i, 1)
            z = x - A0
            
            y1 = z - cc1
            a1 = A0 + y1
            cc1 = (a1 - A0) - y1
            
            y1 = z * (x - a1) - cc2
            ss1 = ss0 + y1
            cc2 = (ss1 - ss0) - y1
            
            A0 = a1
            ss0 = ss1
            k = k + 1
        End If
    Next i
ElseIf nxrows = 1 Then
    For i = 2 To nxcols
        c = CDbl(i)
        If Not IsEmpty(ax(1, i)) Then
            x = ax(1, i)
            z = x - A0
            
            y1 = z - cc1
            a1 = A0 + y1
            cc1 = (a1 - A0) - y1
            
            y1 = z * (x - a1) - cc2
            ss1 = ss0 + y1
            cc2 = (ss1 - ss0) - y1
            
            A0 = a1
            ss0 = ss1
            k = k + 1
        
        End If
    Next i
Else
    Stop
End If
var = ss0 / CDbl(k - 1)
Select Case flag
    Case 1  'mean
        NewOne = A0
    Case 2   'variance
        NewOne = var
    Case 3   'standard deviation
        NewOne = Sqr(var)
    Case 4   'COV value
        If Abs(A0) > 0# Then
            NewOne = Sqr(var) / A0
        Else
            NewOne = 0#
        End If
    Case 5    'L10COV value
        If Abs(A0) > 0# Then
            NewOne = -0.4342944819 * Log(Sqr(var) / Abs(A0))
        Else
            NewOne = 0#
        End If
End Select
End Function
Public Function NewMean(u As Range) As Double
'Uses Welford's algorithm
Dim ax As Variant
Dim nxrows, nxcols As Integer
Dim a1, A0, x, c As Double
Dim i, j, k As Integer

nxrows = u.Rows.count
nxcols = u.Columns.count
ax = u.value
If nxcols = 1 Then
    A0 = ax(1, 1)
    For i = 2 To nxrows
        c = CDbl(i)
        x = ax(i, 1)
        a1 = A0 + (x - A0) / c
        A0 = a1
    Next i
    NewMean = A0
ElseIf nxrows = 1 Then
    A0 = ax(1, 1)
    For i = 2 To nxcols
        c = CDbl(i)
        x = ax(1, i)
        a1 = A0 + (x - A0) / c
        A0 = a1
    Next i
    NewMean = A0
Else
    Stop
End If

End Function
Public Function NewSD(u As Range) As Double
'Uses Welfords algorithm as modified by Knuth
Dim ax As Variant
Dim nxrows, nxcols As Integer
Dim a1, A0, ss1, ss0, x, c As Double
Dim i, j, k As Integer

nxrows = u.Rows.count
nxcols = u.Columns.count
ax = u.value
If nxcols = 1 Then
    If IsEmpty(ax(1, 1)) Then
        NewSD = 0#
        Exit Function
    Else
        A0 = ax(1, 1)
        ss0 = 0#
    End If
    For i = 2 To nxrows
        c = CDbl(i)
        If IsEmpty(ax(i, 1)) Then
        
        Else
            x = ax(i, 1)
            a1 = A0 + (x - A0) / c
            ss1 = ss0 + (x - A0) * (x - a1)
            A0 = a1
            ss0 = ss1
        End If
    Next i
    'Stop
    NewSD = Sqr(ss0 / (c - 1#))
Else
    Stop
End If

End Function
Public Function NewAutoCorrelation(u As Range) As Double

'Uses Welfords algorithm as modified by Knuth
Dim ax As Variant
Dim nxrows, nxcols As Integer
Dim a1, A0, ss1, ss0, x, c As Double
Dim x1, x2, csum As Double
Dim i, j, k As Integer

nxrows = u.Rows.count
nxcols = u.Columns.count
ax = u.value
If nxcols = 1 Then
    A0 = ax(1, 1)
    ss0 = 0#
    For i = 2 To nxrows
        c = CDbl(i)
        x = ax(i, 1)
        a1 = A0 + (x - A0) / c
        ss1 = ss0 + (x - A0) * (x - a1)
        A0 = a1
        ss0 = ss1
    Next i
    
    csum = 0#
    For i = 2 To nxrows
        x1 = ax(i, 1) - a1       'cenered value
        x2 = ax(i - 1, 1) - a1  'centered lag
        csum = csum + x1 * x2
    Next i
    
    NewAutoCorrelation = csum / ss0
Else
    Stop
End If
End Function
Public Function NewCovar(u1 As Range, u2 As Range) As Double

'Uses Welford's algorithm and Kahan's correction
Dim ax, ay As Variant
Dim nxrows, nxcols, nyrows, nycols, nvals As Integer
Dim c, x, y, mx0, mx1, my0, my1 As Double
Dim sx0, sx1, sy0, sy1, sxy0, sxy1 As Double
Dim cc1, cc2, cc3, cc4, cc5, tv As Double
Dim i, j, k, method As Integer
Dim flag As Boolean

flag = False
nxrows = u1.Rows.count
nxcols = u1.Columns.count
nyrows = u2.Rows.count
nycols = u2.Columns.count
If nxcols = 1 And nycols = 1 Then 'covariance of two columns
    If nxrows = nxrows Then
        If nxrows > 1 Then
            'OK on doing the rows
            nvals = nxrows
            flag = True
            method = 1
        End If
    End If
End If

If nxrows = 1 And nyrows = 1 Then 'covariance of two rows
    If nxcols = nxcols Then
        If nxcols > 1 Then
            'OK on doing the columns
            nvals = nxcols
            flag = True
            method = 2
        End If
    End If
End If
ax = u1.value
ay = u2.value

If (IsEmpty(ax(1, 1)) Or IsEmpty(ay(1, 1)) Or Not flag) Then
    NewCovar = 0
    Stop
    Exit Function
End If

mx0 = ax(1, 1)
my0 = ay(1, 1)
sx0 = 0#
sy0 = 0#
sxy0 = 0#
cc1 = 0#
cc2 = 0#
cc3 = 0#
cc4 = 0#
cc5 = 0#
'Stop
For i = 2 To nvals
    c = CDbl(i)
    If method = 1 Then
        x = ax(i, 1)
        y = ay(i, 1)
    Else
        x = ax(1, i)
        y = ay(1, i)
    End If
    'Stop
    'mx1 = mx0 + (x - mx0) / k
    tv = ((x - mx0) / c) - cc1
    mx1 = mx0 + tv
    cc1 = (mx1 - mx0) - tv
    
    'sx1 = sx0 + (x - mx0) * (x - mx1)
    tv = (x - mx0) * (x - mx1) - cc2
    sx1 = sx0 + tv
    cc2 = (sx1 - sx0) - tv
                
    'my1 = my0 + (y - my0) / k
    tv = ((y - my0) / c) - cc3
    my1 = my0 + tv
    cc3 = (my1 - my0) - tv
    
    'sy1 = sy0 + (y - my0) * (y - my1)
    tv = (y - my0) * (y - my1) - cc4
    sy1 = sy0 + tv
    cc4 = (sy1 - sy0) - tv
                
    'sxy1 = sxy0 + (x - mx1) * (y - my0)
    tv = (x - mx1) * (y - my0) - cc5
    sxy1 = sxy0 + tv
    cc5 = (sxy1 - sxy0) - tv
    'Stop
    mx0 = mx1
    sx0 = sx1
    my0 = my1
    sy0 = sy1
    sxy0 = sxy1
Next i

NewCovar = sxy1 / c
'Stop

End Function
Public Function NewCorrel(u1 As Range, u2 As Range) As Double

'Uses Welford's algorithm and Kahan's correction
Dim ax, ay As Variant
Dim nxrows, nxcols, nyrows, nycols, nvals As Integer
Dim c, x, y, mx0, mx1, my0, my1 As Double
Dim sx0, sx1, sy0, sy1, sxy0, sxy1 As Double
Dim cc1, cc2, cc3, cc4, cc5, tv As Double
Dim i, j, k, method As Integer
Dim flag As Boolean

flag = False
nxrows = u1.Rows.count
nxcols = u1.Columns.count
nyrows = u2.Rows.count
nycols = u2.Columns.count
If nxcols = 1 And nycols = 1 Then 'covariance of two columns
    If nxrows = nxrows Then
        If nxrows > 1 Then
            'OK on doing the rows
            nvals = nxrows
            flag = True
            method = 1
        End If
    End If
End If

If nxrows = 1 And nyrows = 1 Then 'covariance of two rows
    If nxcols = nxcols Then
        If nxcols > 1 Then
            'OK on doing the columns
            nvals = nxcols
            flag = True
            method = 2
        End If
    End If
End If
ax = u1.value
ay = u2.value

If (IsEmpty(ax(1, 1)) Or IsEmpty(ay(1, 1)) Or Not flag) Then
    NewCorrel = 0
    Stop
    Exit Function
End If

mx0 = ax(1, 1)
my0 = ay(1, 1)
sx0 = 0#
sy0 = 0#
sxy0 = 0#
cc1 = 0#
cc2 = 0#
cc3 = 0#
cc4 = 0#
cc5 = 0#
'Stop
For i = 2 To nvals
    c = CDbl(i)
    If method = 1 Then
        x = ax(i, 1)
        y = ay(i, 1)
    Else
        x = ax(1, i)
        y = ay(1, i)
    End If
    'Stop
    'mx1 = mx0 + (x - mx0) / k
    tv = ((x - mx0) / c) - cc1
    mx1 = mx0 + tv
    cc1 = (mx1 - mx0) - tv
    
    'sx1 = sx0 + (x - mx0) * (x - mx1)
    tv = (x - mx0) * (x - mx1) - cc2
    sx1 = sx0 + tv
    cc2 = (sx1 - sx0) - tv
                
    'my1 = my0 + (y - my0) / k
    tv = ((y - my0) / c) - cc3
    my1 = my0 + tv
    cc3 = (my1 - my0) - tv
    
    'sy1 = sy0 + (y - my0) * (y - my1)
    tv = (y - my0) * (y - my1) - cc4
    sy1 = sy0 + tv
    cc4 = (sy1 - sy0) - tv
                
    'sxy1 = sxy0 + (x - mx1) * (y - my0)
    tv = (x - mx1) * (y - my0) - cc5
    sxy1 = sxy0 + tv
    cc5 = (sxy1 - sxy0) - tv
    'Stop
    mx0 = mx1
    sx0 = sx1
    my0 = my1
    sy0 = sy1
    sxy0 = sxy1
Next i

NewCorrel = sxy1 / Sqr(sx1 * sy1)
'Stop

End Function
Public Function NewLRE(c1 As Range, c2 As Range) As Double

Dim x1, x2, x3, x4 As Double
Dim lx3, lx2 As Double

x1 = c1
x2 = c2
'Stop
If x2 = 0# Then
    x4 = x1
    'Stop
Else
    x3 = Abs(x1 - x2)
    If x3 = 0 Then
        NewLRE = 16
        Exit Function
    Else
        lx3 = Log(x3) / 2.30258509299405
        lx2 = Log(Abs(x2)) / 2.30258509299405
        NewLRE = -(lx3 - lx2)
        'Stop
        Exit Function
        
    End If
    'Stop
End If
End Function
Public Function LAE(testv, refv) As Double
Dim v1, v2, d1, d2 As Double

If Application.WorksheetFunction.IsNumber(testv) Then
    v1 = Abs(BottomSet(testv))
    If Application.WorksheetFunction.IsNumber(refv) Then
        v2 = Abs(BottomSet(refv))
        If v1 > 1# Then v1 = 1#
        If v2 < 0# Then v2 = 0#
               
        
        If v1 = 0# And v2 = 0# Then
            LAE = 16  'true match
            Exit Function
        End If
        d1 = Abs(v1 - v2)
        If d1 > 0# Then
            d2 = -Log(d1) / 2.30258509299405
            If d2 > 16 Then
                LAE = 16
            ElseIf d2 < -1# Then
                LAE = -1#
            Else
                LAE = d2
            End If
        Else
            LAE = 16
        End If
    Else
        LAE = "#NUM"
    End If
Else
    LAE = "#NUM"
End If

End Function
Public Sub BMean(x() As Double, nlen As Integer, xsum, xbar)
'Calculates the best estimate of a mean of a data list

Dim i, in1, in2, in3, in4, in5 As Integer
Dim flag As Integer
Dim x1, x2, x3, x4 As Double

flag = 0

Rem sorts an array
If nlen <= 1 Then
    Stop
ElseIf nlen > 1 Then
    in5 = nlen
    Do 'loop 1'
        in5 = in5 \ 2
        If in5 = 0 Then Exit Do 'loop 1'
        in2 = 1
        in3 = nlen - in5
        Do 'loop 2'
            in1 = in2
            Do 'loop 3'
                in4 = in1 + in5
                x1 = Abs(x(in1))
                x2 = Abs(x(in4))
                If x1 > x2 Then flag = 2 Else flag = 1
                If flag = 1 Then Exit Do
                If flag = 2 Then 'interchange'
                    x3 = x(in1)
                    x(in1) = x(in4)
                    x(in4) = x3
                    in1 = in1 - in5
                    If in1 < 1 Then Exit Do 'loop 3'
                End If
            Loop 'loop 3'
            in2 = in2 + 1
            If in2 > in3 Then Exit Do 'loop 2'
        Loop 'loop 2'
    Loop  'loop 1'
End If

xsum = 0
For i = 1 To nlen
    xsum = xsum + x(i)
Next i
x4 = CDbl(nlen)
xbar = xsum / x4

End Sub
Public Function Autocorrelation(istart As Integer, iend As Integer, icol As Integer, del As Integer) As Double

Dim y1, y2, y3 As Double
Dim i, j, k, l, m, n As Integer
Dim y() As Double
Dim yi() As Double
Dim ybar, ysum, ysuma, ysumb As Double

m = iend - istart + 1
ReDim y(1 To m), yi(1 To m)

k = del
ysum = 0
j = 0
For i = istart To iend
    j = j + 1
    y(j) = Cells(i, icol).value
    ysum = ysum + y(j)
Next i
ybar = ysum / CDbl(m)

ysuma = 0
ysumb = 0
For i = 1 To m
    yi(i) = y(i) - ybar
    ysuma = ysuma + yi(i) * yi(i)
Next i

For i = 1 + k To m
    ysumb = ysumb + yi(i) * yi(i - k)
Next i

Autocorrelation = ysumb / ysuma
End Function
Public Function DistPercentile(icol As Integer, rowa As Integer, rowb As Integer, tpct As Double) As Double
Dim i, j, k, l, m, n As Integer
Dim xx(), pct() As Double
Dim x1, x2, x3, x4, tv As Double
Dim in1, in2, in3, in4, in5, flag As Integer

If tpct < 0# Or tpct > 100# Then
    Stop
End If

m = rowb - rowa + 1
If m < 3 Then
    Stop
End If
ReDim xx(1 To m), pct(1 To m)
j = 0
For i = rowa To rowb
    j = j + 1
    xx(j) = ActiveSheet.Cells(i, icol).value
    
Next i

Rem sorts an array, smallest to largest

in5 = m
Do 'loop 1'
    in5 = in5 \ 2
    If in5 = 0 Then Exit Do 'loop 1'
    in2 = 1
    in3 = m - in5
    Do 'loop 2'
        in1 = in2
        Do 'loop 3'
            in4 = in1 + in5
            x1 = xx(in1)
            x2 = xx(in4)
            If x1 > x2 Then flag = 2 Else flag = 1
            If flag = 1 Then Exit Do
            If flag = 2 Then 'interchange'
                x3 = xx(in1)
                xx(in1) = xx(in4)
                xx(in4) = x3
                in1 = in1 - in5
                If in1 < 1 Then Exit Do 'loop 3'
            End If
        Loop 'loop 3'
        in2 = in2 + 1
        If in2 > in3 Then Exit Do 'loop 2'
    Loop 'loop 2'
Loop  'loop 1'

x1 = 100# / CDbl(m - 1) 'increment in percentiles
pct(1) = 0#
For i = 2 To m - 1
    pct(i) = pct(i - 1) + x1
Next i
pct(m) = 100#

For i = 1 To m
    If tpct = pct(i) Then
        tv = xx(i)
        Exit For
    ElseIf tpct > pct(i) Then
        If tpct < pct(i + 1) Then 'interpolate between two values
            x2 = xx(i + 1) - xx(i)
            x3 = tpct - pct(i)
            tv = xx(i) + x2 * x3 / x1
            Exit For
        End If
    Else
        Stop
    End If
Next i
DistPercentile = tv

End Function
Function newpearson(xrng As Range, yrng As Range)
Dim x(), y() As Double
Dim ax, ay, vt As Variant
Dim nxrows, nxcols, irow, icol As Integer
Dim nyrows, nycols, jrow, jcol As Integer
Dim xt, yt, xyt, x2t, y2t As Double
Dim d1, d2, D3, d4 As Double
Dim i, j, k As Integer

nxrows = xrng.Rows.count
nxcols = xrng.Columns.count
nyrows = yrng.Rows.count
nycols = yrng.Columns.count
ax = xrng.value
ay = yrng.value

If nxcols = 1 Then
    If nycols = 1 Then
        If nxrows = nyrows Then
            ReDim x(1 To nxrows)
            ReDim y(1 To nyrows)
        Else
            Stop
        End If
    Else
        Stop
    End If
Else
    Stop
End If

For irow = 1 To nxrows
    vt = ax(irow, 1)
    x(irow) = vt
    vt = ay(irow, 1)
    y(irow) = vt
Next irow

xt = 0
yt = 0
xyt = 0
x2t = 0
y2t = 0
 
For i = 1 To nxrows
    xt = xt + x(i)
    yt = yt + y(i)
    x2t = x2t + x(i) * x(i)
    y2t = y2t + y(i) * y(i)
    xyt = xyt + x(i) * y(i)
Next i

d1 = nxrows * xyt - xt * yt
d2 = nxrows * x2t - xt * xt
D3 = nxrows * y2t - yt * yt
d4 = Sqr(d2 * D3)
newpearson = d1 / d4

End Function
Function SerialCorrel(arry As Range, intrvl, method) As Double

Dim i, j, k, il, ih, ic, irs, irn, nvals, ntrm, iup As Integer
Dim ssq, trm, xv, sum As Double
Dim m1, m2, s1, s2, x1, x2 As Double
Dim meth As Integer

ic = arry.Column
irs = arry.Row
irn = arry.count
iup = irs + irn - 1

'calculates mean and total sum of squares
m1 = Cells(irs, ic).value
s1 = 0#
For i = 2 To irn
    k = irs + i - 1
    xv = Cells(k, ic).value
    m2 = m1 + (xv - m1) / CDbl(i)
    s2 = s1 + (xv - m1) * (xv - m2)
    m1 = m2
    s1 = s2
Next i
nvals = intrvl
meth = method
ntrm = 0

Select Case meth
    Case 1
        ih = irs - 1
        sum = 0#
        Do
            il = ih
            For i = 1 To nvals
                il = il + 1
                ih = il + nvals
                If ih > iup Then
                    Exit Do
                Else
                    x1 = Cells(il, ic) - m1
                    x2 = Cells(ih, ic) - m1
                    trm = x1 * x2
                    sum = sum + trm
                    ntrm = ntrm + 1
                End If
            Next i
        Loop
        trm = (sum / s1) * (CDbl(irn) / CDbl(ntrm))
    Case 2
        il = irs - 1
        Do
            il = il + 1
            ih = il + nvals
            If ih > iup Then
                Exit Do
            Else
                x1 = Cells(il, ic) - m1
                x2 = Cells(ih, ic) - m1
                trm = x1 * x2
                sum = sum + trm
                ntrm = ntrm + 1
            End If
        Loop
        trm = (sum / s1) * (CDbl(irn) / CDbl(ntrm))
    
    Case Else
        trm = 0#
End Select
If trm < -1# Then trm = -1#
If trm > 1# Then trm = 1#
SerialCorrel = trm

End Function
Function ClassCount(arry As Range, nvalues As Range, classmin As Range, classmax As Range) As Integer

Dim ic, irs, irn, jc, jrs, i, k As Integer
Dim mnc, mnr, mxc, mxr As Integer
Dim vmin, vmax, x As Double
Dim count As Integer

ic = arry.Column
irs = arry.Row
jc = nvalues.Column
jrs = nvalues.Row
irn = Cells(jrs, jc)

mnc = classmin.Column
mnr = classmin.Row
mxc = classmax.Column
mxr = classmax.Row
vmin = Cells(mnr, mnc)
vmax = Cells(mxr, mxc)
count = 0

For i = 1 To irn
    k = irs + i - 1
    x = Cells(k, ic)
    If x >= vmin Then
        If x <= vmax Then
            count = count + 1
        End If
    End If
Next i
ClassCount = count

End Function
Function ValueCount(arry As Range, ival As Range) As Double
Dim ic, irs, irn, jc, jrs, i, k As Integer
Dim mnc, mnr, mxc, mxr As Integer
Dim vref, vmax, x As Double
Dim count As Integer

ic = arry.Column
irs = arry.Row
irn = arry.count

jc = ival.Column
jrs = ival.Row
vref = Cells(jrs, jc)
'Stop
count = 0
For i = 1 To irn
    k = irs + i - 1
    x = Cells(k, ic)
    'Stop
    If x = vref Then
        count = count + 1
    End If
Next i
ValueCount = count
End Function
Function ConvertToString(xn) As String
'XN is the input floating point number
'The basis is that if XN is zero, all the 32 bits of the integer are set to 0
'If XN is exactly 1.0, then all 32 bits of the integer are set to 1.
Dim xin As Double
Dim xa1, xa2, xa3, xa4, xa5, xa6, ka7, xa8 As Double
Dim sl, sh, sk, sc, ss As String
Dim ll, k, i, j, n1, NN As Integer
Dim HLHP, HLLP As Long
Dim jj As Integer

xin = Abs(xn)
If xin < 1# Then
    xa1 = 4294967295# * xin   'convert to 32 bit integer form with fraction
    xa2 = Fix(xa1)           'get integer portion
    xa3 = xa1 - xa2          'get fractional portion
    If xa3 > 0.5 Then        'round integer portion
        xa4 = xa2 + 1#       'XA4 is the rounded integer as a floating point number
    Else
        xa4 = xa2
    End If
    sh = Hex$(15)
    ll = Len(sh)
    'Stop

    If xa4 > 2147483647# Then  '32 bits have to be treated
        'exceeds long integer size, do stuff to recover upper & lower bytes
        xa5 = xa4 / 16#    'get high part
        xa6 = Fix(xa5)     'fix high part
        xa3 = xa5 - xa6    'lower difference
        HLHP = CLng(xa6)    'this will always have 7 hexidecimal digis
        HLLP = CLng(16# * xa3)  'This will always have 1 hexidecimal digit
        sl = Hex$(HLLP)     'convert lower part to hexidecimal
        sh = Hex$(HLHP)     'convert higher part to hexidecimal
        sc = sh + sl       'this will always be 8 hexidecimal characters
        'Stop
    Else
        Rem within long integer range
        sl = Hex$(CLng(xa4))        'convert lower part to hexidecimal
        ll = Len(sl)
        Select Case ll
            Case 8
                sc = sl
            Case 7
                sc = "0" + sl
            Case 6
                sc = "00" + sl
            Case 5
                sc = "000" + sl
            Case 4
                sc = "0000" + sl
            Case 3
                sc = "00000" + sl
            Case 2
                sc = "000000" + sl
            Case 1
                sc = "0000000" + sl
            Case 0
                sc = "00000000"
        End Select
    End If

    If Len(sc) = 8 Then
        'Reduce 8 hexidecimal character string to a 4 character string
        k = 0
        ss = ""
        For i = 1 To 4
            For j = 1 To 2
                k = k + 1
                sk = Mid$(sc, k, 1)
                Select Case sk
                    Case Is = "0"
                        n1 = 0
                    Case Is = "1"
                        n1 = 1
                    Case Is = "2"
                        n1 = 2
                    Case Is = "3"
                        n1 = 3
                    Case Is = "4"
                        n1 = 4
                    Case Is = "5"
                        n1 = 5
                    Case Is = "6"
                        n1 = 6
                    Case Is = "7"
                        n1 = 7
                    Case Is = "8"
                        n1 = 8
                    Case Is = "9"
                        n1 = 9
                    Case Is = "A"
                        n1 = 10
                    Case Is = "B"
                        n1 = 11
                    Case Is = "C"
                        n1 = 12
                    Case Is = "D"
                        n1 = 13
                    Case Is = "E"
                        n1 = 14
                    Case Is = "F"
                        n1 = 15
                    Case Else
                        Stop
                End Select
                Select Case j
                    Case 1
                        NN = 16 * n1
                    Case 2
                        NN = NN + n1
                End Select
            Next j
            'Stop
            sk = String$(1, NN)
            ss = ss + sk
        Next i
    Else
        ss = String$(4, 255)
    End If
Else
    ss = "11111111"
End If
ConvertToString = ss
End Function
Sub confidencetest()
Dim cnt, hloc, hb, hc As Long
Dim u1, u2, x0, x1, x2, x3, v As Double
Dim s1, s2, s3, s4, s5 As String
Dim A0, a1, ss0, ss1 As Double
Dim var, ave, sqrn, stdint As Double
Dim setx(1 To 8) As Double
Dim sig(1 To 3) As Double 'sigma values for 90%, 95% and 99%
Dim tvl(1 To 3) As Double  't-dist values for 90%,95% and 99%, n=8
Dim popm, pops, std, supper, slower As Double
Dim incl(1 To 3) As Long
Dim iexl(1 To 3) As Long
Dim jncl(1 To 3) As Long
Dim jexl(1 To 3) As Long
Dim kncl(1 To 3) As Long
Dim kexl(1 To 3) As Long
Dim asize As Long
Dim i, j, nsize As Integer
Dim PT1, PT2, PT3, PT4, PT5, PT6 As Double

nsize = 8
v = CDbl(nsize - 1)
PT1 = 0.95
PT2 = 0.975
PT3 = 0.995
'sig(1) = Normalinverse(PT1)
'sig(2) = Normalinverse(PT2)
'sig(3) = Normalinverse(PT3)
PT4 = 2 * (1 - PT1)
PT5 = 2 * (1 - PT2)
PT6 = 2 * (1 - PT3)
tvl(1) = Application.WorksheetFunction.TInv(PT4, v)
tvl(2) = Application.WorksheetFunction.TInv(PT5, v)
tvl(3) = Application.WorksheetFunction.TInv(PT6, v)

popm = 0#
pops = 1#

asize = 3200000 / nsize
sqrn = Sqr(CDbl(nsize))

Open "D:\rndzfile.bin" For Binary As #2
hloc = 1&
cnt = 0&
With Application
    'get a set of 8 random z values, optain mean and standard deviation
    Do
        For i = 1 To nsize
            If cnt >= 3200000 Then
                Close
                Exit Do
            End If
            Get #2, hloc, x1
            'Stop
            cnt = cnt + 1&
            hloc = hloc + 12&
            If i > 1 Then
                a1 = A0 + (x1 - A0) / CDbl(i)
                ss1 = ss0 + (x1 - A0) * (x1 - a1)
                A0 = a1
                ss0 = ss1
            Else
                A0 = x1
                ss0 = 0#
            End If
            'Stop
        Next i
        std = Sqr(ss0 / (nsize - 1))
        'Stop
        For j = 1 To 3 'over the three probabilities, normal distribution, population variance
            stdint = sig(j) / sqrn
            slower = A0 - stdint 'lower confidence limit
            supper = A0 + stdint 'upper confidence limit
            If popm > slower Then       'test to determime if popm is within the limits
                If popm < supper Then
                    incl(j) = incl(j) + 1 'within
                Else
                    iexl(j) = iexl(j) + 1  'outside
                End If
            Else
                iexl(j) = iexl(j) + 1   'outside
            End If
            'Stop
        Next j
        For j = 1 To 3 'over the three probabilities, normal distribution, sample variances
            stdint = std * sig(j) / sqrn
            slower = A0 - stdint 'lower confidence limit
            supper = A0 + stdint 'upper confidence limit
            If popm > slower Then       'test to determime if popm is within the limits
                If popm < supper Then
                    jncl(j) = jncl(j) + 1 'within
                Else
                    jexl(j) = jexl(j) + 1  'outside
                End If
            Else
                jexl(j) = jexl(j) + 1   'outside
            End If
            'Stop
        Next j
        
        For j = 1 To 3 'over the three probabilities, t distribution
            stdint = std * tvl(j) / sqrn
            slower = A0 - stdint 'lower confidence limit
            supper = A0 + stdint 'upper confidence limit
            If popm > slower Then       'test to determime if popm is within the limits
                If popm < supper Then
                    kncl(j) = kncl(j) + 1 'within
                Else
                    kexl(j) = kexl(j) + 1  'outside
                End If
            Else
                kexl(j) = kexl(j) + 1   'outside
            End If
            'Stop
        Next j
    Loop
    .Worksheets("Sheet1").Cells(5, 1) = nsize
    .Worksheets("Sheet1").Cells(5, 2) = 2 * PT1 - 1
    .Worksheets("Sheet1").Cells(5, 3) = sig(1)
    .Worksheets("Sheet1").Cells(5, 4) = incl(1)
    .Worksheets("Sheet1").Cells(5, 5) = iexl(1)
    .Worksheets("Sheet1").Cells(5, 6) = incl(1) + iexl(1)
    .Worksheets("Sheet1").Cells(5, 7) = incl(1) / (incl(1) + iexl(1))
    .Worksheets("Sheet1").Cells(6, 1) = nsize
    .Worksheets("Sheet1").Cells(6, 2) = 2 * PT2 - 1
    .Worksheets("Sheet1").Cells(6, 3) = sig(2)
    .Worksheets("Sheet1").Cells(6, 4) = incl(2)
    .Worksheets("Sheet1").Cells(6, 5) = iexl(2)
    .Worksheets("Sheet1").Cells(6, 6) = incl(2) + iexl(2)
    .Worksheets("Sheet1").Cells(6, 7) = incl(2) / (incl(2) + iexl(2))
    .Worksheets("Sheet1").Cells(7, 1) = nsize
    .Worksheets("Sheet1").Cells(7, 2) = 2 * PT3 - 1
    .Worksheets("Sheet1").Cells(7, 3) = sig(3)
    .Worksheets("Sheet1").Cells(7, 4) = incl(3)
    .Worksheets("Sheet1").Cells(7, 5) = iexl(3)
    .Worksheets("Sheet1").Cells(7, 6) = incl(3) + iexl(3)
    .Worksheets("Sheet1").Cells(7, 7) = incl(3) / (incl(3) + iexl(3))

    .Worksheets("Sheet1").Cells(5, 8) = sig(1)
    .Worksheets("Sheet1").Cells(5, 9) = jncl(1)
    .Worksheets("Sheet1").Cells(5, 10) = jexl(1)
    .Worksheets("Sheet1").Cells(5, 11) = jncl(1) + jexl(1)
    .Worksheets("Sheet1").Cells(5, 12) = jncl(1) / (jncl(1) + jexl(1))
    .Worksheets("Sheet1").Cells(6, 8) = sig(2)
    .Worksheets("Sheet1").Cells(6, 9) = jncl(2)
    .Worksheets("Sheet1").Cells(6, 10) = jexl(2)
    .Worksheets("Sheet1").Cells(6, 11) = jncl(2) + jexl(2)
    .Worksheets("Sheet1").Cells(6, 12) = jncl(2) / (jncl(2) + jexl(2))
    .Worksheets("Sheet1").Cells(7, 8) = sig(3)
    .Worksheets("Sheet1").Cells(7, 9) = jncl(3)
    .Worksheets("Sheet1").Cells(7, 10) = jexl(3)
    .Worksheets("Sheet1").Cells(7, 11) = jncl(3) + jexl(3)
    .Worksheets("Sheet1").Cells(7, 12) = jncl(3) / (jncl(3) + jexl(3))
    
    .Worksheets("Sheet1").Cells(5, 13) = tvl(1)
    .Worksheets("Sheet1").Cells(5, 14) = kncl(1)
    .Worksheets("Sheet1").Cells(5, 15) = kexl(1)
    .Worksheets("Sheet1").Cells(5, 16) = kncl(1) + kexl(1)
    .Worksheets("Sheet1").Cells(5, 17) = kncl(1) / (kncl(1) + kexl(1))
    .Worksheets("Sheet1").Cells(6, 13) = tvl(2)
    .Worksheets("Sheet1").Cells(6, 14) = kncl(2)
    .Worksheets("Sheet1").Cells(6, 15) = kexl(2)
    .Worksheets("Sheet1").Cells(6, 16) = kncl(2) + kexl(2)
    .Worksheets("Sheet1").Cells(6, 17) = kncl(2) / (kncl(2) + kexl(2))
    .Worksheets("Sheet1").Cells(7, 13) = tvl(3)
    .Worksheets("Sheet1").Cells(7, 14) = kncl(3)
    .Worksheets("Sheet1").Cells(7, 15) = kexl(3)
    .Worksheets("Sheet1").Cells(7, 16) = kncl(3) + kexl(3)
    .Worksheets("Sheet1").Cells(7, 17) = kncl(3) / (kncl(3) + kexl(3))

End With
End Sub
Function ConfidNorm(typec, side, pval, mean, stdev, size) As Variant
Dim i, j, k, l, lev As Integer
Dim pin, v, df, sqrn, xbar, sig As Double
Dim p1, u1, z, t As Double
'set up for input errors
k = typec
If k < 1 Or k > 3 Then
    ConfidNorm = "incorrect type"
    Exit Function
End If

l = side
If l < 0 Or l = 1 Then
    lev = 1
ElseIf l > 0 Or l = 2 Then
    lev = 2
Else
    ConfidNorm = "incorrect side"
    Exit Function
End If

pin = pval
If pin < 0 Or pin > 1 Then
    ConfidNorm = "incorrect p input"
    Exit Function
End If

v = size
If v <= 0 Then
    ConfidNorm = "incorrect size"
    Exit Function
End If
df = v - 1
sqrn = Sqr(v)

xbar = mean
sig = Abs(stdev)
Select Case k
    Case 1
        'input population mean, population standard deviation
        'calculate interval for sample means
        'use z table
        p1 = (1 + pin) / 2
        z = Application.WorksheetFunction.NormSInv(p1)
        u1 = Abs(sig * z / sqrn)
        Select Case lev
            Case 1
                ConfidNorm = xbar - u1
            Case 2
                ConfidNorm = xbar + u1
        End Select
        'Stop
    Case 2
        'input sample mean, population standard deviation
        'calculate interval for population mean
        'use z table
        p1 = (1 + pin) / 2
        z = Application.WorksheetFunction.NormSInv(p1)
        u1 = Abs(sig * z / sqrn)
        Select Case lev
            Case 1
                ConfidNorm = xbar - u1
            Case 2
                ConfidNorm = xbar + u1
        End Select
        'Stop
    Case 3
        'input sample mean, sample standard deviation
        'calculate interval for population means
        'use t table
        p1 = 1 - pin
        t = Application.WorksheetFunction.TInv(p1, df)
        u1 = Abs(sig * t / sqrn)
        Select Case lev
            Case 1
                ConfidNorm = xbar - u1
            Case 2
                ConfidNorm = xbar + u1
        End Select
        'Stop
End Select
Stop
End Function
Function confidproportion(nsuccesses, ntotal, confidpval, side) As Variant
'uses the Clopper and Pearson exact interval at nsuccesses=0 and when nsucesses=ntotal.
'uses the Wilson score confidence interval
'See TAS, Vol 52, No. 2, Page 119 and TAS Vol 55, No. 4, Page 337
Dim i, l, lev As Integer
Dim n, k, phat, qhat, u1, u2 As Double
Dim pin, alpha  As Double
Dim z, zsq As Double
'set up for input errors

l = side
If l < 0 Or l = 1 Then
    lev = 1
ElseIf l > 0 Or l = 2 Then
    lev = 2
Else
    confidproportion = "incorrect side"
    Exit Function
End If

pin = confidpval
If pin < 0 Or pin > 1 Then
    confidproportion = "incorrect p input"
    Exit Function
End If
If pin > 0.5 Then
    alpha = (1 - pin) / 2#
Else
    alpha = pin / 2#
End If
z = Application.WorksheetFunction.NormSInv(alpha)

n = Fix(ntotal + 0.01)
k = Fix(nsuccesses + 0.01)
phat = k / n
qhat = 1# - phat

If k = 0# Then
    If lev = 1 Then  'at 0'
        confidproportion = 0#
    Else
        confidproportion = 1 - Exp(Log(alpha) / n)
    End If
    Exit Function
End If
If k = n Then
    If lev = 1 Then  'at 1'
        confidproportion = Exp(Log(alpha) / n)
    Else
        confidproportion = 1#
    End If
    Exit Function
End If
zsq = z * z
u1 = (k + zsq / 2) / (n + zsq)
u2 = (n * phat * qhat - zsq / 4) / (n + zsq) ^ 2
If lev = 1 Then
    confidproportion = u1 - z * Sqr(u2)
Else
    confidproportion = u1 + z * Sqr(u2)
End If

End Function

Function ConfidStdDev(typec, pval, stdev, size, side) As Variant
'calculates confidence intervals
Dim pin, p1, p2, x1, x2, u1, u2, u3, u4, u5, v, df As Double
Dim i, j, k, l, lev As Integer
Dim xbar, sig, sqrn, t, z, q1 As Double

'set up for input errors
k = typec
If k < 1 Or k > 2 Then
    ConfidStdDev = "incorrect type"
    Exit Function
End If

l = side
If l < 0 Or l = 1 Then
    lev = 1
ElseIf l > 0 Or l = 2 Then
    lev = 2
Else
    ConfidStdDev = "incorrect side"
    Exit Function
End If

pin = pval
If pin < 0 Or pin > 1 Then
    ConfidStdDev = "incorrect p input"
    Exit Function
End If

v = size
If v <= 0 Then
    ConfidStdDev = "incorrect size"
    Exit Function
End If
df = v - 1
sqrn = Sqr(v)

sig = Abs(stdev)
Select Case k
    Case 1
        'input population standard deviation
        'calculate interval for sample standard deviations
        'use chi-square table
        u1 = sig * sig / df
        p1 = (1 - pin) / 2
        p2 = (1 + pin) / 2
        Select Case lev
            Case 1 'lower
                z = Application.WorksheetFunction.ChiInv(p2, df)
                u2 = u1 * z
                ConfidStdDev = Sqr(u2)
            Case 2  'upper
                z = Application.WorksheetFunction.ChiInv(p1, df)
                u2 = u1 * z
                ConfidStdDev = Sqr(u2)
        End Select
        'Stop
    Case 2
        'input sample standard deviation
        'calculate interval for population standard deviations
        'use chi-square table
        u1 = sig * sig * df
        p1 = (1 - pin) / 2
        p2 = (1 + pin) / 2
        Select Case lev
            Case 1 'lower
                z = Application.WorksheetFunction.ChiInv(p1, df)
                u2 = u1 / z
                ConfidStdDev = Sqr(u2)
            Case 2  'upper
                z = Application.WorksheetFunction.ChiInv(p2, df)
                u2 = u1 / z
                ConfidStdDev = Sqr(u2)
        End Select
        'Stop
End Select

End Function
Function BottomSet(xvalue) As Variant
'converts small values to Excel's zero threshold
Dim u As Double
If Application.WorksheetFunction.IsNumber(xvalue) Then
    u = xvalue
    If Abs(u) < 2.2250738585072E-308 Then
        BottomSet = 0#
    Else
        BottomSet = u
    End If
Else
    BottomSet = xvalue
End If
'u = -Log(2.2250738585072E-308) / 2.30258509299405
'Stop

End Function
Function pRangeTest(pin) As Boolean
Dim p As Double
Dim flag As Boolean
p = pin
flag = True
If p < 0# Then
    flag = False
End If
If p > 1.0000000001 Then
    flag = False
End If
pRangeTest = flag

End Function
Function PTestLRE(testp, refp, refq) As Variant
Dim ptest, qtest, rp, rq, tp As Double
Dim d1, d2, v3 As Double

If Application.WorksheetFunction.IsNumber(testp) Then
    ptest = testp
    If pRangeTest(ptest) Then
        ptest = Abs(BottomSet(testp))
        If Application.WorksheetFunction.IsNumber(refp) Then
            rp = refp
            If pRangeTest(rp) Then
                rp = Abs(BottomSet(rp))
                If Application.WorksheetFunction.IsNumber(refq) Then
                    rq = refq
                    If pRangeTest(rq) Then
                        rq = Abs(BottomSet(rq))
                        'have an acceptable set of values for ptest, rp and rq
                        If ptest = rp Then  'deal with equality first
                            PTestLRE = 16
                            Exit Function
                        End If
                        'unequal, proceed
                        tp = rp + rq
                        If tp > 0.99999999999 Then 'proceed, tp and tq sufficiently accurate
                            If ptest < 0.5 Then 'use standard LRE stuff
                                If ptest = 0# And rp = 0# Then
                                    d2 = 16  'true match
                                Else
                                    d1 = Abs(ptest - rp)
                                    If d1 > 0# Then
                                        If ptest = 0# Then
                                            v3 = d1 / rp
                                        ElseIf rp = 0# Then
                                            v3 = d1 / ptest
                                        Else
                                            v3 = d1 / rp
                                        End If
                                        d2 = -Log(v3) / 2.30258509299405
                                    Else  'equality value match
                                        d2 = 16
                                    End If
                                End If
                            Else   'p greater than 0.5, use modified right tail stuff
                                qtest = 1# - ptest
                                If qtest = 0# And rq = 0# Then
                                    d2 = 16  'true match
                                Else
                                    d1 = Abs(qtest - rq)
                                    If d1 > 0# Then
                                        If qtest = 0# Then
                                            v3 = d1 / rq
                                        ElseIf rq = 0# Then
                                            v3 = d1 / qtest
                                        Else
                                            v3 = d1 / rq
                                        End If
                                        d2 = -Log(v3) / 2.30258509299405
                                    Else  'equality value match
                                        d2 = 16
                                    End If
                                End If
                            End If
                            If d2 > 16 Then
                                PTestLRE = 16
                            ElseIf d2 < -1# Then
                                PTestLRE = -1#
                            Else
                                PTestLRE = d2
                            End If
                            Exit Function
                        Else  'the sum of the test values are not accurate enough
                            PTestLRE = "SUM"
                        End If
                    Else 'rq range is bad
                        PTestLRE = "qbad"
                    End If
                Else 'qref not a number
                    PTestLRE = "qNUM"
                End If
            Else 'p range bad
                PTestLRE = "pbad"
            End If
        Else 'refp not a numberr
            PTestLRE = "pNUM"
        End If
    Else 'ptest not in range
        PTestLRE = "tbad"
    End If
Else 'testp not a number
    PTestLRE = "tNUM"
End If
End Function
Function LRE(testv, refv) As Variant
Dim d1, d2, v1, v2, v3, dr As Double

If Application.WorksheetFunction.IsNumber(testv) Then
    v1 = testv
    v1 = Abs(BottomSet(v1))
    If Application.WorksheetFunction.IsNumber(refv) Then
        v2 = refv
        v2 = Abs(BottomSet(v2))
        If v1 = 0# And v2 = 0# Then
            LRE = 16  'true match
            Exit Function
        End If
        
        If v2 = 0# And v1 <> 0# Then
            d2 = -Log(Abs(v1)) / 2.30258509299405
            If d2 > 16 Then
                LRE = 16
            ElseIf d2 < -1# Then
                LRE = -1#
            Else
                LRE = d2
            End If
            Exit Function
        End If
        If v1 <> 0# And v2 <> 0# Then
            d1 = Abs(v1 - v2)
            If d1 > 0# Then
                v3 = d1 / v2
                d2 = -Log(v3) / 2.30258509299405
                If d2 > 16 Then
                    LRE = 16
                ElseIf d2 < -1# Then
                    LRE = -1#
                Else
                    LRE = d2
                End If
            Else
                LRE = 16
            End If
            Exit Function
        End If
    Else 'refv is not a number
        LRE = "rNUM"
    End If
Else 'tesv not a number
    LRE = "tNUM"
End If
End Function
Function LPV(pvalue, qvalue) As Variant
'Limited upper end to 16 for ploting and lower end to -307.653
Dim p, q, outv, d, val As Double
Dim tagp, tagq As Variant
tagp = pvalue
tagq = qvalue
If Application.WorksheetFunction.IsNumber(tagp) Then
    p = pvalue
    p = BottomSet(p)
    If pRangeTest(p) Then 'p is in a proper range
        If Application.WorksheetFunction.IsNumber(tagq) Then
            q = qvalue
            q = BottomSet(q)
            If pRangeTest(q) Then 'q is in a proper range
                'p  and q all have values and are in proper ranges
                If p = 1# Then
                    LPV = 16
                    Exit Function
                End If
                If p = 0# Then
                    LPV = BLX
                    Exit Function
                End If
                If q = 0# Then
                    d = 1# - p
                Else
                    d = q
                End If
                If p > 0.5 Then
                    If d > 0# Then
                        val = -Application.WorksheetFunction.Log10(d)
                    Else
                        val = 16
                    End If
                Else  'p < 0.5
                    val = Application.WorksheetFunction.Log10(p)
                End If
                If val < BLX Then val = BLX
                If val > 16 Then val = 16
                LPV = val
                Exit Function
            Else  'q not in proper range
                LPV = "qout"
            End If
        Else
            LPV = "qNUM"
        End If
    Else
        LPV = "pout"
    End If
Else
    LPV = "pNUM"
End If
End Function
Function FindMinimumRow(lst) As Integer
'Finds row number for a minimum value in range lst
Dim arry As Range
Dim ic, irs, irn, iup, rown, i, k As Integer
Dim xv, refx As Double

Set arry = lst
ic = arry.Column
irs = arry.Row
irn = arry.count
iup = irs + irn - 1
refx = 1E+306
'Stop
For i = 1 To irn
    k = irs + i - 1
    xv = ActiveSheet.Cells(k, ic).value
    If xv < refx Then
        refx = xv
        rown = k
    End If
    'Stop
Next i
FindMinimumRow = rown
End Function
Function ReturnValue(irow, icolumn) As Variant
'returns cell contents for irow and icolumn as integers
ReturnValue = ActiveSheet.Cells(irow, icolumn)

End Function
Function fpr(xin As Double, ndigits As Double, basis As Boolean) As Double
'Does rounding to ndigits significant leading digits of floating point numbers
'if basis is true, then uses the Excel ROUND Function
'if basis is false, does floating point rounding of leading digits
Dim vin, v1, v2, v3, v4, v5, v6, avin, dpnd, vout, vsign As Double
Dim indigits As Integer
Dim rndcase As Boolean
rndcase = basis
v1 = xin
If v1 < 1E-306 Then
    vin = BottomSet(v1) 'ensures zero for number less than rmin
Else
    vin = v1
End If
avin = Abs(vin)
indigits = ndigits  'integer form
dpnd = ndigits   'double precision form
If vin = 0# Then
    fpr = 0#
    Exit Function
End If
If indigits = 0 Then
    fpr = 0#
    Exit Function
End If
If vin = 1# Then
    fpr = 1#
    Exit Function
End If
If xin < 0 Then
    vsign = -1#
Else
    vsign = 1#
End If
'Stop
If rndcase Then 'use existing ROUND function
    If avin < 1 Then 'use function in input
        vout = Application.WorksheetFunction.Round(avin, dpnd)
        'Stop
    Else
        v1 = Application.WorksheetFunction.Log10(avin)
        v2 = Fix(v1) + 1  'digits to the left of the decimal point
        v3 = dpnd - v2  'digits to the right of the decimal point
        If v3 < 0 Then 'more digits than defined by ndigits
            v4 = 10 ^ v2
            v5 = avin / v4
            v6 = Application.WorksheetFunction.Round(v5, dpnd)
            vout = v6 * v4
        Else
            vout = Application.WorksheetFunction.Round(avin, v3)
        End If
        'Stop
    End If
    fpr = vsign * vout
    Exit Function
Else
    
    v1 = Application.WorksheetFunction.Log10(avin)
    If v1 < 0 Then 'small numbers
        v2 = -Fix(v1) + dpnd
        If v2 >= 307 Then 'smaller than excel can handle
            v3 = 10 ^ v1
            v4 = avin * v3
            v5 = Application.WorksheetFunction.Round(v4, dpnd)
            vout = v5 / v3
        Else
            v3 = 10 ^ v2
            v4 = avin * v3
            v5 = Fix(v4)
            v6 = v4 - v5
            If v6 > 0.5 Then v5 = v5 + 1
            vout = v5 / v3
        End If
    Else  'large numbers
        v2 = Fix(v1) - dpnd + 1
        If v2 > 0 Then  'reduce to n digits right of decimal point
            v3 = 10 ^ v2
            v4 = avin / v3
            v5 = Fix(v4)
            v6 = v4 - v5
            If v6 > 0.5 Then v5 = v5 + 1
            vout = v5 * v3
        Else 'expand to n digits right of decimal point
            v2 = Abs(v2)
            v3 = 10 ^ v2
            v4 = avin * v3
            v5 = Fix(v4)
            v6 = v4 - v5
            If v6 > 0.5 Then v5 = v5 + 1
            vout = v5 / v3
        End If
    End If
    fpr = vsign * vout
    'Stop
    Exit Function
End If
End Function
Function ncoltoacol(nin) As String

Dim n0, n1, n2, n3 As Integer
Dim s1, s2, s3 As String

n0 = nin
n1 = (n0 - 1) \ 26
If n1 > 0 Then
    n2 = n0 - 26 * n1
    If n2 > 0 Then
        s1 = String$(1, n1 + 64)
        s2 = String$(1, n2 + 64)
        ncoltoacol = s1 + s2
    Else
        ncoltoacol = String$(1, n0 + 64)
    End If
Else
    ncoltoacol = String$(1, n0 + 64)
End If
'Stop
End Function