Finding Median - Gouped by field

[Bob]

I have been looking at the code for MedianFind(pDte As String) from the
following thread from UtterAccess.com: "Finding Median average grouped
by field"

I have been able to get it to run using Northwind no problem. I am
having some trouble though converting it to my specific purpose which
may be less complicated than the solution Bob (raskew) provided in the
thread.

Here are my specifics:

1) I only have one table (FactorTable) with two fields (neighborhood,
ratio).
2) I am looking for the Median of the 'ratio' field for EACH
'neighborhood'.

For Example:
Hood Ratio
501 1
501 2
501 3
601 2
601 4
601 6
etc....

I need a resulting table to spit out:

Hood Median
501 2
601 4

....or at least:

Hood Median
501 2
501 2
501 2
601 4
601 4
601 4
etc....

I have seen this questions posted in several forums (and groups) but
have yet to see an answer.
Can this be done????

Thanks alot in advance!

Bob

[mikejhnu]

Bob, the following function will do what you are requesting. Before
running it you will need to create a query called MedianQuery, whose
SQL is:
SELECT FactorTable.neighbourhood, FactorTable.ratio
FROM FactorTable
WHERE ((Not (FactorTable.neighbourhood) Is Null) AND (Not
(FactorTable.ratio) Is Null))
ORDER BY FactorTable.neighbourhood, FactorTable.ratio;

Public Function CreateMedianTable()

Dim dbs As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field,
fld2 As DAO.Field
On Error GoTo Err_median
Set dbs = CurrentDb
dbs.TableDefs.Delete "Median Table"
dbs.TableDefs.Refresh

Set tdf = dbs.CreateTableDef("Median Table")
Set fld = tdf.CreateField("Category", dbText, 40)
Set fld2 = tdf.CreateField("Median value", dbSingle, 40)
tdf.Fields.Append fld
tdf.Fields.Append fld2
tdf.Fields.Refresh
dbs.TableDefs.Append tdf
dbs.TableDefs.Refresh

Dim rst As DAO.Recordset
Dim rstM As DAO.Recordset
Dim myarray(2000) As Variant
Dim title1 As String
Dim fieldname As String
Dim medianresult As Variant
Dim A As Integer
Dim B As Integer
title1 = "MedianQuery"
Dim appXL As New Excel.Application

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(title1)
Set rstM = dbs.OpenRecordset("Median Table")
rst.MoveFirst
Do While Not rst.EOF
fieldname = rst.Fields(0).Value
B = 1
Do While rst.Fields(0) = fieldname
myarray(B) = rst.Fields(1)
rst.MoveNext
If rst.EOF Then Exit Do
B = B + 1
Loop
medianresult = appXL.Median(myarray)
rstM.AddNew
rstM.Fields("Category") = fieldname
rstM.Fields("Median value") = medianresult
rstM.Update
Erase myarray 'sets each element to empty
Loop
rst.Close
rstM.Close
dbs.Close
appXL.Quit

DoCmd.OpenTable ("Median Table")

Exit_median:
Exit Function

Err_median:
If Err.Number = 3265 Then
Resume Next
Else
MsgBox Error$
Resume Exit_median
End If

End Function

[Mike]

I forgot to add that you will need Microsoft Excel on your computer as
well as a reference to Microsoft Excel in your access database.

Mike