A one-way ANOVA for Ability Spreadsheet

[Database Administrator]

Sub Oneway()
'One-way ANOVA with unbalanced treatment groups
'Data are expected to be organized as variables in columns
' rows - cases
'The first row of the selected data block should be text = names of
treatments

Dim IntRawDatRows
Dim IntRawDatCols

set RawDat = Selection

intRawDatRows = GetnumRows(RawDat.Address)
intRawDatCols = RawDat.Count / intRawDatRows

Redim dblDat(intRawDatCols, intRawDatRows - 1)
Redim strTreatNam(intRawDatCols)
Redim dblReplicates(intRawDatCols)
Redim dblMeans(intRawDatCols)
Redim dblStdErrors(intRawDatCols)
Redim dblResiduals(intRawDatCols, IntRawDatRows - 1)
Redim StrOWRowLables(5)
Redim StrOWColLables(6)
Redim StrOWTreatLables(3)


Dim intTreatments

intTreatments = intRawDatCols

Dim intN 'total number of cases

intN = 0

Dim dblTotal

dblTotal = 0

Dim dblTestN

dblTestN = 0

Dim dblGrandMean

dblGrandMean = 0

Dim dblTreatSS

dblTreatSS = 0

Dim dblResidualSS

dblResidualSS = 0

Dim intTreatDF

intTreatDF = 0

Dim intResidualDF

intResidualDF = 0

Dim dbltreatMS

dblTreatMS = 0

dim dblResidualMS

dblResidualMS = 0

dim dblF

dblF = 0

dim dblProbFVal

dblProbFVal = 0

dim strSigF

strSigF = ""

Dim i, j, k, temp, l, t1, t2, w

i = 0: j = 0: k = 0: l = 0
t1 = 0: t2 = 0: w = 0

For i = 1 to intRawDatCols
dblReplicates(i) = 0
next

k = 1
For i = 1 to intRawDatRows
For j = 1 to intRawDatCols
if i = 1 then
strTreatNam(j) = RawDat(k).Value
else
temp = i - 1
if Isnumeric(RawDat(k).Value) then
if isEmpty(RawDat(k).Value) then
'
else
dblDat(j,temp) = RawDat(k).Value
dblReplicates(j) = dblReplicates(j) + 1
intN = intN + 1
end if
end if
end if
k = k + 1
next
next

'Calculate Means
For i = 1 to intTreatments
t1 = 0
for j = 1 to dblReplicates(i)
t1 = t1 + dblDat(i,j)
next
dblMeans(i) = t1/dblReplicates(i)
dblTotal = dblTotal + t1
dblTestN = dblTestN + dblReplicates(i)
next
dblGrandMean = dblTotal/intN

'Calculate Sums of Squares
for i = 1 to intTreatments
t2 = 0
for j = 1 to dblReplicates(i)
w = dblDat(i,j) - dblmeans(i)
t2 = t2 + w * w
dblresiduals(i,j) = w
next
dblResidualSS = dblResidualSS + t2
w = dblMeans(i) - dblGrandMean
dblTreatSS = dblTreatSS + dblReplicates(i) * w * w
next

intTreatDF = intTreatments - 1
intResidualDF = intN - intTreatments

dblTreatMS = dblTreatSS / intTreatDF
dblResidualMS = dblResidualSS / intResidualDF
dblF = dblTreatMS / dblResidualMS ' F - value

dblProbFVal = 1 - FDist(dblF, intTreatDF, intResidualDF) 'Probability
of F-value

if dblProbFVal < 0.01 then
strSigF = "Significant at 1% level"
elseif dblProbFVal < 0.05 then
strSigF = "Significant at 5% level"
else
strSigF = "Not Significant"
end if

'Calculate standard errors
For i = 1 to intTreatments
dblStdErrors(i) = Sqr(dblResidualSS/(dblReplicates(i) *
intResidualDF))
next

'Output
StrOWRowLables(1) = "SOURCE"
StrOWRowLables(2) = ""
StrOWRowLables(3) = "Treatments"
StrOWRowLables(4) = "Residual"
StrOWRowLables(5) = "TOTAL"

Set OneWayOutput = RawDat.cells(1, intRawdatCols + 3)
For i = 1 To 5
OneWayOutput.cells(i,1).Value = StrOWRowLables(i)
Next

StrOWColLables(1) = "SS"
StrOWColLables(2) = "df"
StrOWColLables(3) = "MS"
StrOWColLables(4) = "F"
StrOWColLables(5) = "p"
StrOWColLables(6) = "Significance"

For j = 1 To 6
i = j + 1
OneWayOutput.cells(1,i).Value = StrOWColLables(j)
Next

OneWayOutput.cells(3,2).Value = Round(dblTreatSS,5)
OneWayOutput.cells(4,2).Value = Round(dblResidualSS,5)
OneWayOutput.cells(5,2).Value = Round(dblTreatSS + dblResidualSS,5)
OneWayOutput.cells(3,3).Value = intTreatDF
OneWayOutput.cells(4,3).Value = intResidualDF
OneWayOutput.cells(5,3).Value = intN - 1
OneWayOutput.cells(3,4).Value = Round(dblTreatMS,5)
OneWayOutput.cells(4,4).Value = Round(dblResidualMS,5)
OneWayOutput.cells(3,5).Value = Round(dblF,5)
OneWayOutput.cells(3,6).Value = Round(dblProbFVal,5)
OneWayOutput.cells(3,7).Value = strSigF

StrOWTreatLables(1) = "Treatment"
StrOWTreatLables(2) = "Mean"
StrOWTreatLables(3) = "Std Error"

For i = 1 To 3
OneWayOutput.cells(7,i).Value = StrOWTreatLables(i)
Next
For j = 1 To intTreatments
i = j + 7
OneWayOutput.cells(i,1).Value = strTreatNam(j)
Next

For j = 1 To intTreatments
i = j + 7
OneWayOutput.cells(i,2).Value = Round(dblMeans(j),5)
Next

For j = 1 To intTreatments
i = j + 7
OneWayOutput.cells(i,3).Value = Round(dblStdErrors(j),5)
Next









end sub



Function Normal(z)
'Normal distribution - approximation
dim a1, a2, a3, a4, prob, w

prob = 0
w = 0
a1 = 0.196854
a2 = 0.115194
a3 = 0.000344
a4 = 0.019527

w = abs(z)
prob = 1 + w * (a1 + w * (a2 + w * (a3 + w * a4)))
prob = prob^4
prob = 1 - 0.5 / prob
prob = 0.5 + (prob - 0.5) * sgn(z)
Normal = prob

end function

Function FDist(F, df1, df2)
'F-distribution Function Approximation
dim a1, a2, w, w1, w2, z, prob

prob = 0 : w = 0 : w2 = 0: a1 = 0 : a2 = 0 : z = 0

a1 = 2/(9 * df1)
a2 = 2/(9 * df2)
w = F^(1/3)
w1 = w + a1 - w * a2 - 1
w2 = a2 * w * w + a1
z = w1/sqr(w2)

If df2 > 3 then
FDist = Normal(z)
else
z = z * (1 + 0.08 * (z^4)/(df2^3))
FDist = Normal(z)
end if


End Function


Function GetNumRows(r)

StartRow = GetNum(r, 2)

i = InStr(r, ".") + 3
EndRow = GetNum(r, i)

GetNumRows = EndRow - StartRow + 1

End Function

Function GetNum(r, i)

x = Mid(r, i, 1)
If (IsNumeric(x) = False) Then
i = i + 1
x = Mid(r, i, 1)
End If

y = ""
While (IsNumeric(x))
y = y & x
i = i + 1
x = Mid(r, i, 1)
Wend

GetNum = y

End Function