calculate median 2

[dt2demar]

How can I calculate the median in Access?

Thanks,

Don

 

[dodge20]

Here is an example of something I have used in the past.

SELECT AVG(SeqCol)
FROM (
SELECT MAX(SeqCol)
FROM (
SELECT TOP 50 PERCENT SeqCol
FROM yourTable
ORDER BY SeqCol ASC
) AS _D1(SeqCol)
UNION ALL
SELECT MIN(SeqCol)
FROM (
SELECT TOP 50 PERCENT SeqCol
FROM yourTable
ORDER BY SeqCol DESC
) AS _D2(SeqCol)
) AS _Derived(SeqCol)

Dodge20

 

[dodge20]

Here is a module if you would like

Public Function MedianOfRst(RstName As String, fldName As String) As Double
'This function will calculate the median of a recordset. The field must be a number value.
Dim MedianTemp As Double
Dim RstOrig As Recordset
Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)
RstOrig.Sort = fldName
Dim RstSorted As Recordset
Set RstSorted = RstOrig.OpenRecordset()
If RstSorted.RecordCount Mod 2 = 0 Then
RstSorted.AbsolutePosition = (RstSorted.RecordCount / 2) - 1
MedianTemp = RstSorted.Fields(fldName).Value
RstSorted.MoveNext
MedianTemp = MedianTemp + RstSorted.Fields(fldName).Value
MedianTemp = MedianTemp / 2
Else
RstSorted.AbsolutePosition = (RstSorted.RecordCount - 1) / 2
MedianTemp = RstSorted.Fields(fldName).Value
End If
MedianOfRst = MedianTemp
End Function

Private Sub test()
MsgBox MedianOfRst("Orders", "Freight&quot
End Sub

Dodge20

 

[dt2demar]

Thanks. This is very helpful.

 

[puter55]

That works well, do you have one for the standard deviation?

 

[dodge20]

This isn't my code, and I haven't tested it, but it looks as though this works.

'
' Module level constants
'
Private Const strMcARRAY_TYPE_NAME As String = "Variant()"
'
' The Min, Max, Sum, Avg, Mean, Variance, Stdev methods
' all allow a sequence of numbers to be passed into the method
' Each of these methods has an equivalent xArray method
' which excepts an array rather than a sequence of numbers
'
Public Function Min(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Min = MinArray(arrLvArray)
End Function

Public Function Max(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Max = MaxArray(arrLvArray)
End Function

Public Function Sum(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Sum = SumArray(arrLvArray)
End Function

Public Function Avg(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Avg = AvgArray(arrLvArray)
End Function

Public Function Mean(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Mean = AvgArray(arrLvArray)
End Function

Public Function Variance(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Variance = VarianceArray(arrLvArray)
End Function

Public Function Stdev(ParamArray vrnVvParamArray() As Variant) As Variant
Dim arrLvArray() As Variant
If TypeName(vrnVvParamArray(0)) = strMcARRAY_TYPE_NAME Then
arrLvArray = vrnVvParamArray(0)
Else
Call ConvertParamArrayToArray(vrnVvParamArray(), arrLvArray())
End If
Stdev = StdevArray(arrLvArray)
End Function
'
' The xArray functions allow a single dimensioned array
' to be passed in with each element a number
'
Private Function MinArray(ByRef vrnRvNumbers() As Variant) As Variant
Dim intLvIndex As Integer
MinArray = vrnRvNumbers(LBound(vrnRvNumbers()))
For intLvIndex = LBound(vrnRvNumbers()) To UBound(vrnRvNumbers())
MinArray = IIf(vrnRvNumbers(intLvIndex) < MinArray, vrnRvNumbers(intLvIndex), MinArray)
Next
End Function

Private Function MaxArray(ByRef vrnRvNumbers() As Variant) As Variant
Dim intLvIndex As Integer
MaxArray = vrnRvNumbers(LBound(vrnRvNumbers()))
For intLvIndex = LBound(vrnRvNumbers()) To UBound(vrnRvNumbers())
MaxArray = IIf(vrnRvNumbers(intLvIndex) > MaxArray, vrnRvNumbers(intLvIndex), MaxArray)
Next
End Function

Private Function SumArray(ByRef vrnRvNumbers() As Variant) As Variant
Dim intLvIndex As Integer
SumArray = 0
For intLvIndex = LBound(vrnRvNumbers()) To UBound(vrnRvNumbers())
SumArray = SumArray + vrnRvNumbers(intLvIndex)
Next
End Function

Private Function AvgArray(ByRef vrnRvNumbers() As Variant) As Variant
AvgArray = SumArray(vrnRvNumbers) / ArraySize(vrnRvNumbers)
End Function

Private Function MeanArray(ByRef vrnRvNumbers() As Variant) As Variant
MeanArray = AvgArray(vrnRvNumbers)
End Function

Private Function VarianceArray(ByRef vrnRvNumbers() As Variant) As Variant
Dim intLvIndex As Integer
Dim vrnLvMean As Variant: vrnLvMean = AvgArray(vrnRvNumbers)
VarianceArray = 0
For intLvIndex = LBound(vrnRvNumbers()) To UBound(vrnRvNumbers())
VarianceArray = VarianceArray + Square(vrnRvNumbers(intLvIndex) - vrnLvMean)
Next
VarianceArray = VarianceArray / ArraySize(vrnRvNumbers)
End Function

Private Function StdevArray(ByRef vrnRvNumbers() As Variant) As Variant
StdevArray = Sqr(VarianceArray(vrnRvNumbers))
End Function
'
' Additional methods
'
Public Function Square(ByVal vrnVvNumber As Variant) As Variant
Square = (vrnVvNumber * vrnVvNumber)
End Function
'
' Internal methods
'
Private Function ConvertParamArrayToArray(ByVal vrnVvParamArray As Variant _
, ByRef vrnRvArray() As Variant _
) As Variant
Dim intLvIndex As Integer
ReDim vrnRvArray(UBound(vrnVvParamArray) - LBound(vrnVvParamArray))
For intLvIndex = LBound(vrnVvParamArray) To UBound(vrnVvParamArray)
vrnRvArray(intLvIndex) = vrnVvParamArray(intLvIndex)
Next
End Function

Private Function ArraySize(ByRef vrnRvArray() As Variant) As Long
ArraySize = UBound(vrnRvArray) - LBound(vrnRvArray) + 1
End Function


Dodge20

 

[dt2demar]

Dodge20, with respect to your earlier response, can you give me a example (in SQL) of how I could use 'Public Function MedianOfRst' in a query to generate the median of a field called 'Values' in a table called 'VTable'?

Thanks,

Don

 

[SXS2001us]

I'm trying to calculate the median using a query in Access2000. The table in the Access database has a column of numbers of which I need to calculate the median.

 

[awaddington]

Hi there,

My question may help as I think I have found how to do what you are trying to find.

I am trying to find the median value of prices grouped by a region using a query in MS access:

region_name price
---------------- ------
region1 $2.00
region2 $2.10
region1 $1.90
...

I have an sql statement taht will yiled the median for the entire table

SELECT x.price AS median
FROM

AS x,

AS y
GROUP BY x.price
HAVING
(((Sum(IIf([y].[price]<=[x].[price],1,0)))>=(Count(*)+1)/2) AND
((Sum(IIf([y].[price]>=[x].[price],1,0)))>=(Count(*)+1)/2));

But I cannot figure out how to group the findings be region.

 

[PHV]

Have you tried something like this ?
SELECT x.region, x.price AS median
FROM

AS x INNER JOIN

AS y ON x.region = y.region
GROUP BY x.region, x.price
HAVING
(((Sum(IIf([y].[price]<=[x].[price],1,0)))>=(Count(*)+1)/2) AND
((Sum(IIf([y].[price]>=[x].[price],1,0)))>=(Count(*)+1)/2));


Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[awaddington]

Thanks PVH,

I ended up needing to use a user defined function in VBA, FindMedian().

And now I am faced with the problem of accessing th data from applications outside MSAccess. Namely Excel, which I need to use to generate graphs for use in Word Docs.

When I try to link to the query (which uses the user defined function) using "Get External Data..." in Excel, it returns an error saying that is doesn't recognize the function.

If anyone can think of a way to solve this problem It would be most appreciated.

Cheers

 

[HFloyd]

Dear PHV,

Thanks for posting the SQL for grouping. Just one question - I noticed that this doesn't work on groups where there is an even number of records. Is there some way to alter the SQL to fix that?

Thanks Again!

Heather


Floyd Innovations

http://www.floydinnovations.com

 

[raskew]

Here are a couple of possible solutions. The first based on finding the median from a recordset (Northwind's Orders table used as an example), the second based on an user-inputted list .

Function MedianF(ptable As String, pfield As String) As Single
'*******************************************
'Re:        [URL unfurl="true"]http://www.utteraccess.com/forums/postlist.php?Cat=&Board=85[/URL]
'Purpose:   Return median value from a recordset
'Coded by:  raskew
'Inputs:    ? medianF("Orders", "Freight") <enter.
'Output:    41.36 (may vary according to hom much
'           you've fiddled with this table).
'*******************************************

Dim rs       As Recordset
Dim strSQL   As String
Dim n        As Integer
Dim sglHold  As Single

    strSQL = "SELECT " & pfield & " from " & ptable & " WHERE " & pfield & ">0 Order by " & pfield & ";"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    rs.MoveLast
    n = rs.RecordCount
    rs.Move -Int(n / 2)
    
    If n Mod 2 = 1 Then 'odd number of elements
       MedianF = rs(pfield)
    Else                'even number of elements
       sglHold = rs(pfield)
       rs.MoveNext
       sglHold = sglHold + rs(pfield)
       MedianF = sglHold / 2
    End If
    rs.Close
End Function

Function Medianx(ParamArray varNums() As Variant) As Variant
'*******************************************
'Purpose:   Return the median from a parameter
'           array of numbers
'Coded by:  raskew
'Inputs:    (1) ? medianx(1,11,8,3,6,13)
'           (2) ? medianx(1,11,8,3,6)
'Output:    (1) 7
'           (2) 6
'*******************************************

Dim i    As Integer
Dim j    As Integer
Dim n    As Integer
Dim temp As Integer

    n = UBound(varNums)
    If (n < 0) Then
       Exit Function
    Else
       'use bubble sort to sequence the elements
       '(good for small number of elements but
       'slow for larger sorts)
       For i = 0 To UBound(varNums)
          For j = 0 To UBound(varNums)
             If varNums(i) < varNums(j) Then
                temp = varNums(i)
                varNums(i) = varNums(j)
                varNums(j) = temp
             End If
          Next j
       Next i
    End If
    'If there's an odd number of elements, median = center element
    'e.g. if elements = 1,3,6,8,11 then median = 6
    'With an even number elements, median = average of 2 center elements
    'e.g. if elements = 1,3,6,8,11,13 then median = (6+8)/2 = 7
    Medianx = IIf(n Mod 2 = 0, varNums(n / 2), (varNums(n \ 2) + varNums(n \ 2 + 1)) / 2)
    
    'To display results, uncomment the following 3 lines
    'For i = 0 To UBound(varNums)
    '   Debug.Print varNums(i)
    'Next i

End Function

HTH - Bob

 

[HFloyd]

Dear Bob,

Thanks for the code. I actually managed to locate some great code from the Access Cookbook, basically a DMedian() function in the same structure as the built-in domain functions - DMax, etc., which worked well in a query using an Expression column, even with multiple grouping fields.

Heather

Floyd Innovations

http://www.floydinnovations.com