Calculating a median value 3

[KHerm]

Is there a function or known formula to find the median value for a list in Access?

Thanks,

Ken

 

[RickSpr]

A list? Do you mean an array of values? How about this:

Public Function Median(Values() As Single) As Single
    Dim i As Integer, min As Single, max As Single
    
    min = Values(LBound(Values))
    max = min
    For i = LBound(Values) + 1 To UBound(Values)
        If min > Values(i) Then min = Values(i)
        If max < Values(i) Then max = Values(i)
    Next i
    Median = (min + max) / 2#
End Function

Rick Sprague

 

[JerryDennison]

That's close Rick but you didn't allow for an odd number of values in your array. In the case of an odd number of values you don't average the two middle values you simply find the middle value of the ordered set.

 

[RickSpr]

Oops! It's been too long since statistics, I guess. I didn't average the middle values, either--I calculated the midpoint of the whole range. I guess an accurate median function would have to sort the values in the array, then determine the middle value (if an odd number of values) or the average of the two middle values (if an even number). I can see why you were looking for a built-in function! Rick Sprague

 

[JerryDennison]

Oops, Rick! I've made a grave error (didn't read your post good enough). Your formula is wrong all the way around. The median is not the average of the min/max values of the dataset. The median is the middle value of an ordered set. If the set is an odd integer then the value is whatever the middle value happens to be. If the set has an even number of values then it is the average of the two middle values. So to create a function it can be designed in one of two ways. Pass an already ordered dataset, then all that's needed is to find the middle value. The alternative is to pass an unordered dataset, sort it, then find the middle value. Your code would work well for this with just a few modifications.

 

[KHerm]

I see I should have been more specific. I apologize. I have a table with a column I need to find the median value for a government report. The median value will be a column in a fixed length dataset. I know I can use a query to select the rows, filter them from from high to low, note the number of rows and either find the value in the middle row or average the value in the two middle rows in an even list. I was hoping to be able to do that in some kind of coded way because this report gets generated quarterly. Is my "manual way" what you are talking about, Jerry?

Ken

 

[MichaelRed]

Well, it certainly can be done. I think a few more details need to be included, to be sure your's getting the "right" MEDIAN.

Are there any "Nulls" in the field of Interest? If so, are they part of the data set?

e.g. If i have a table 0f 745 records, but the field of interest has 25 null (or empty) values Would I be reporting the 743rd record's value, or the average of the 360th and 361st (Non-Null) values?

When you refer to "filter them from from high to low", do you mean sort? Or are some records excluded (e.g. Criteria is applied to the recordset)?



MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over

 

[KHerm]

There will be no null values or zeros in the column where I must find the median value. Right now I'm finding the median manually. I query the table in Access. In the Datasheet view, I filter the column from high to low, although it would have made no difference if I had filtered low to high. I then note the number of rows, find the middle one or two rows, depending, and there's my median.

The data is grouped by four categories, and of course each category has it's own median. So I do the query four times. And there are four reports with four medians each, so you can see why I'm working on a function or formula to get this quarterly project done. The kicker is, that for each line of the fixed length output the median is the same for each row in each category, so I then alter my query and use the IIf function to put in the right median:

IIf(category=A,25,(IIf(category=B,19,(IIf(category=C,101,45))))

My plan right now is to create a temp table with category and median and then join it to the query that I use to export to my flat file. Still working on it.

And thanks for you help!

Ken

 

[JerryDennison]

You could do it manually, but it would be much better to pass an array(i.e. dataset) to a function and let it find the median for you. Just as you would using Dsum or DAvg. Or, you could use a third party add-in that has these types of functions. I'm not at home so I can't give you the name of one. I will though when I get home. But writing a function to return the median wouldn't be too difficult. I've written similar ones before. I'm not really trying to plug anything here but I would be glad to quote on writing a fully debugged and tested function for you, if you're interested.

 

[KHerm]

Well, I wish I could pay for something like that, but thanks for the offer. I'm going to keep working on it, though!

Ken

 

[dneufarth]

Try this

http://www.fabalou.com/Access/Modules/recordset_median.htm

Dave

 

[JerryDennison]

That is an excellent site Dave. The only drawback with that function is you must build the recordset(if you want it limited you'll have to build a query first). What I can offer is a domain aggregate function just like Dsum(). Whereby you can pass the field, domain(query or table), and criteria to the function. Makes it much easier to use for reporting purposes.

 

[KHerm]

What do I need to do to build a recordset? I tried that function and got an error at

Set RstSorted = RstOrig.OpenRecordset()

with error: Compile Error: Method or data member not found.

Sure would like to make something like this work.

Ken

 

[JerryDennison]

It appears to be written for DAO. If you have A2k you may need to convert it to ADO.

 

[timgill]

I have created the following functions to calculate Median, Percentiles and Quartiles (they work properly, I work for the American Statistical Association!).

Sorry for the post being so long, but I wanted to be sure you had all you would need. Others might find them useful as well.

I use "TextWrap" all the time. It will take a fieldname, and SQL string, and loop through the records to create a CSV list of the values in the given fieldname.

Let me know if you have any questions.

Basically, you'll need the following functions:
CountCSVWords, GetCSVWord, TextWrap, Median, Quartile and Percentile.

Here they are:

===========================================================
Public Function Median(varValues As String) As Variant

Dim varTemp1 As Variant
Dim varTemp2 As Variant
Dim varCount As Variant
varCount = CountCSVWords(varValues)
If varCount > 0 Then
If varCount Mod 2 = 0 Then
' Even number of values, need to average middle two
varTemp1 = GetCSVWord(varValues, varCount / 2)
varTemp2 = GetCSVWord(varValues, (varCount / 2) + 1)
Median = Int((Val(varTemp1) + Val(varTemp2)) / 2)
Else
' Odd number of values, take middle value
Median = Int(GetCSVWord(varValues, (varCount + 1) / 2))
End If
End If
End Function

===========================================================

Public Function Quartile(varValues As String, varIndex As Integer) As Variant
' figure this one out!
' Given n = number of values
' 1st => z = (n+1)/4
' 2nd => z = (n+1)/2
' 3rd => z = 3*((n+1)/4)
' 1st => z = (n+1)/20
' 19th => z = 19*(n+1)/20
' If n is odd, take the zth number in the set
' If n is even, take the zth number, then take the remainder of z * the difference of the zth number and the next number
'MsgBox varIndex, vbOKCancel
If varIndex > 0 Or varIndex < 4 Then

Dim n As Integer
Dim z As Variant
Dim varTemp1 As Variant
Dim varTemp2 As Variant
Dim varDiff As Variant
n = CountCSVWords(varValues)

If n = 1 Then
Quartile = Int(GetCSVWord(varValues, 1))
Else
Select Case varIndex
Case 1
' 1st => z = (n+1)/4 given n = number of values
z = (n + 1) / 4

Case 2
' 2nd => z = (n+1)/2 given n = number of values
z = (n + 1) / 2

Case 3
' 3rd => z = 3*((n+1)/4) given n = number of values
z = 3 * ((n + 1) / 4)

End Select

If n Mod 2 = 0 Then 'Even Number of values
varTemp1 = GetCSVWord(varValues, Int(z))
varTemp2 = GetCSVWord(varValues, Int(z) + 1)
varDiff = varTemp2 - varTemp1
Quartile = Int(varTemp1 + (varDiff * (z - Int(z))))

Else ' Odd number of values
Quartile = Int(GetCSVWord(varValues, Int(z)))
End If
End If

Else
Quartile = &quot;N/A&quot;
End If

End Function

===========================================================

Public Function Percentile(varValues As String, varIndex As Integer) As Variant
' Given n = number of values
' 1st => z = (n+1)/20
' 19th => z = 19*(n+1)/20
' If n is odd, take the zth number in the set
' If n is even, take the zth number, then take the remainder of z * the difference of the zth number and the next number
'MsgBox varIndex, vbOKCancel
If varIndex >= 1 And varIndex <= 20 Then

Dim n As Integer
Dim z As Variant
Dim varTemp1 As Variant
Dim varTemp2 As Variant
Dim varDiff As Variant
'How many values are there?
n = CountCSVWords(varValues)
'MsgBox n

If n = 1 Then
Percentile = Int(GetCSVWord(varValues, 1))
Else
z = varIndex * (n + 1) / 20
'MsgBox z
If n Mod 2 = 0 And n <> Int(z) Then 'Even Number of values
varTemp1 = GetCSVWord(varValues, Int(z))
varTemp2 = GetCSVWord(varValues, Int(z) + 1)
varDiff = varTemp2 - varTemp1
Percentile = Int(varTemp1 + (varDiff * (z - Int(z))))

Else ' Odd number of values
Percentile = Int(GetCSVWord(varValues, Int(z)))
End If
End If

Else
Percentile = &quot;N/A&quot;
End If

End Function

===========================================================

Public Function textwrap(FieldName As String, SQLALL As String) As String
On Error GoTo Error_TextWrap
' Creates a comma separated list of values from the given fieldname for the recordset in SQLALL
Dim TextHolder As String
Dim MyTable As Recordset
Dim mydb As DATABASE

TextHolder = &quot;&quot;
Set mydb = CurrentDb
Set MyTable = mydb.OpenRecordset(SQLALL, DB_OPEN_DYNASET)
If Not MyTable.EOF Then
MyTable.MoveFirst
Do Until MyTable.EOF
TextHolder = TextHolder &amp; MyTable(FieldName) &amp; &quot;, &quot;
MyTable.MoveNext
Loop
End If
If TextHolder = &quot;&quot; Then
textwrap = &quot;&quot;
Else
textwrap = Left$(TextHolder, Len(TextHolder) - 2)
End If

Exit Function

Error_TextWrap:
MsgBox Err.Description, , Err.Number
Exit Function
End Function

===========================================================

Function CountCSVWords(S) As Integer
'
' Counts words in a string separated by commas
'
Dim WC As Integer, Pos As Integer
If VarType(S) <> 8 Or Len(S) = 0 Then
CountCSVWords = 0
Exit Function
End If
WC = 1
Pos = InStr(S, &quot;,&quot
Do While Pos > 0
WC = WC + 1
Pos = InStr(Pos + 1, S, &quot;,&quot
Loop
CountCSVWords = WC
End Function

===========================================================

Function GetCSVWord(S, Indx As Integer)
Dim WC As Integer, Count As Integer, SPos As Integer, EPos As Integer
WC = CountCSVWords(S)
If Indx < 1 Or Indx > WC Then
GetCSVWord = Null
Exit Function
End If
Count = 1
SPos = 1
For Count = 2 To Indx
SPos = InStr(SPos, S, &quot;,&quot + 1
Next Count
EPos = InStr(SPos, S, &quot;,&quot - 1
If EPos <= 0 Then EPos = Len(S)
GetCSVWord = Mid(S, SPos, EPos - SPos + 1)
End Function

===========================================================


Tim Gill
Gill Consulting

http://www.dagills.com

 

[KHerm]

Thanks again Rick, Jerry, Michael, neufarth, and Tim!! Your information has been most helpful and is being used already.

The functions work with Access97. If I knew what DAO and ADO meant maybe I could get them to work at home on Access2000 too!

This is a great place!

Ken

 

[lulubelle2]

I tried the code above from Tim Gill (which is awesome by the way) but got a syntax error at the line in the textWrap function listed below:
TextHolder =TextHolder &amp;MyTable(fieldName) &amp;&quot;,&quot;
Help, anyone? Thanks! I LOVE this website! Lulubelle2

 

[MichaelRed]

TextHolder = TextHolder & MyTable(fieldName) &","
            ^            ^

Add spaces as indicated by the Carets





MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over