By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
455,486 Members | 1,749 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 455,486 IT Pros & Developers. It's quick & easy.

Median Function

P: 78
I am using this module in my access database for median :

Expand|Select|Wrap|Line Numbers
  1. Public Function DMedian( _
  2.  ByVal strField As String, ByVal strDomain As String, _
  3.  Optional ByVal strCriteria As String) As Variant
  4.  
  5.     ' Purpose:
  6.     '     To calculate the median value
  7.     '     for a field in a table or query.
  8.     ' In:
  9.     '     strField: the field
  10.     '     strDomain: the table or query
  11.     '     strCriteria: an optional WHERE clause to
  12.     '                  apply to the table or query
  13.     ' Out:
  14.     '     Return value: the median, if successful;
  15.     '                   Otherwise, an Error value.
  16.  
  17.     Dim db As DAO.Database
  18.     Dim rstDomain As DAO.Recordset
  19.     Dim strSQL As String
  20.     Dim varMedian As Variant
  21.     Dim intFieldType As Integer
  22.     Dim intRecords As Integer
  23.  
  24.     Const errAppTypeError = 3169
  25.  
  26.     On Error GoTo HandleErr
  27.  
  28.     Set db = CurrentDb()
  29.  
  30.     ' Initialize return value
  31.     varMedian = Null
  32.  
  33.     ' Build SQL string for recordset
  34.     strSQL = "SELECT " & strField & " FROM " & strDomain
  35.  
  36.     ' Only use a WHERE clause if one is passed in
  37.     If Len(strCriteria) > 0 Then
  38.         strSQL = strSQL & " WHERE " & strCriteria
  39.     End If
  40.  
  41.     strSQL = strSQL & " ORDER BY " & strField
  42.  
  43.     Set rstDomain = db.OpenRecordset(strSQL, dbOpenSnapshot)
  44.  
  45.     ' Check the data type of the median field
  46.     intFieldType = rstDomain.Fields(strField).Type
  47.     Select Case intFieldType
  48.     Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbDate
  49.         ' Numeric field
  50.         If Not rstDomain.EOF Then
  51.             rstDomain.MoveLast
  52.             intRecords = rstDomain.RecordCount
  53.             ' Start from the first record
  54.             rstDomain.MoveFirst
  55.  
  56.             If (intRecords Mod 2) = 0 Then
  57.                 ' Even number of records
  58.                 ' No middle record, so move to the
  59.                 ' record right before the middle
  60.                 rstDomain.Move ((intRecords \ 2) - 1)
  61.                 varMedian = rstDomain.Fields(strField)
  62.                 ' Now move to the next record, the
  63.                 ' one right after the middle
  64.                 rstDomain.MoveNext
  65.                 ' And average the two values
  66.                 varMedian = (varMedian + rstDomain.Fields(strField)) / 2
  67.                 ' Make sure you return a date, even when
  68.                 ' averaging two dates
  69.                 If intFieldType = dbDate And Not IsNull(varMedian) Then
  70.                     varMedian = CDate(varMedian)
  71.                 End If
  72.             Else
  73.                 ' Odd number or records
  74.                 ' Move to the middle record and return its value
  75.                 rstDomain.Move ((intRecords \ 2))
  76.                 varMedian = rstDomain.Fields(strField)
  77.             End If
  78.         Else
  79.             ' No records; return Null
  80.             varMedian = Null
  81.         End If
  82.     Case Else
  83.         ' Non-numeric field; so raise an app error
  84.         Err.Raise errAppTypeError
  85.     End Select
  86.  
  87.     DMedian = varMedian
  88.  
  89. ExitHere:
  90.     On Error Resume Next
  91.     rstDomain.Close
  92.     Set rstDomain = Nothing
  93.     Exit Function
  94.  
  95. HandleErr:
  96.     ' Return an error value
  97.     DMedian = CVErr(Err.Number)
  98.     Resume ExitHere
  99. End Function
Rather than finding text strings on the form/report, I have set up an expression in the control source. Where the field in question is SalePrice and the table in question is GENERAL.

Expand|Select|Wrap|Line Numbers
  1. =DMedian("SoldPrice","GENERAL")
However it returns "#Error" in the control.

Any Ideas on what is going wrong?

The field in question a currency datatype.
Nov 25 '11 #1

✓ answered by wisni1rr

SOLVED!

I used the following code to calculate the median of the fields. Both fields in question have returned appropriate values in my first round of tests.

Expand|Select|Wrap|Line Numbers
  1. Function Median (tName As String, fldName As String) As Single
  2.   Dim MedianDB As DAO.Database
  3.   Dim ssMedian As DAO.Recordset
  4.   Dim RCount As Integer, i As Integer, x As Double, y As Double, _
  5.       OffSet As Integer
  6.   Set MedianDB = CurrentDB()
  7.   Set ssMedian = MedianDB.Openrecordset("SELECT [" & fldName & _
  8.             "] FROM [" & tName & "] WHERE [" & fldName & _ 
  9.             "] IS NOT NULL ORDER BY [" & fldName  & "];")
  10.   'NOTE: To include nulls when calculating the median value, omit
  11.   'WHERE [" & fldName & "] IS NOT NULL from the example.
  12.   ssMedian.MoveLast
  13.   RCount% = ssMedian.RecordCount
  14.   x = RCount Mod 2
  15.   If x <> 0 Then
  16.      OffSet = ((RCount + 1) / 2) - 2
  17.      For i% = 0 To OffSet
  18.         ssMedian.MovePrevious
  19.      Next i
  20.      Median = ssMedian(fldName)
  21.   Else
  22.      OffSet = (RCount / 2) - 2
  23.      For i = 0 To OffSet
  24.         ssMedian.MovePrevious
  25.      Next i
  26.      x = ssMedian(fldName)
  27.      ssMedian.MovePrevious
  28.      y = ssMedian(fldName)
  29.      Median = (x + y) / 2
  30.   End If
  31.   If Not ssMedian Is Nothing Then
  32.      ssMedian.Close
  33.      Set ssMedian = Nothing
  34.   End If
  35.   Set MedianDB = Nothing
  36. End Function
  37.  
I also needed to enter this into the Declarations

Expand|Select|Wrap|Line Numbers
  1. Option Explicit
Thanks for your help guys!!!

Share this Question
Share on Google+
11 Replies


NeoPa
Expert Mod 15k+
P: 31,709
Wisni1rr:
Where the field in question is SalePrice and the table in question is GENERAL.
Expand|Select|Wrap|Line Numbers
  1. =DMedian("SoldPrice","GENERAL")
I expect it's the wrong field name.
Nov 25 '11 #2

P: 78
Thank you, NeoPa.

The field in question is SoldPrice from the GENERAL table. The CODE was posted correctly in the first post.

Expand|Select|Wrap|Line Numbers
  1. =DMedian("SoldPrice","GENERAL")
The first post was incorrect in regards to the field in question.
Nov 28 '11 #3

NeoPa
Expert Mod 15k+
P: 31,709
So does that mean it's working now?
Nov 28 '11 #4

P: 78
No. The error still exists.

I also have the same error when trying with a different field.

I am using the code as an expression in the ControlSource Property.

Expand|Select|Wrap|Line Numbers
  1. =DMedian("SoldPrice","GENERAL")
and
Expand|Select|Wrap|Line Numbers
  1. =DMedian("DOM","GENERAL")
SoldPrice is a number datatype set as currency and DOM is a calculated field returning a number.

Both read as #ERROR in report view.
Nov 28 '11 #5

NeoPa
Expert Mod 15k+
P: 31,709
In that case I see nothing immediately likely to cause that, but you've posted a hundred lines of code there so you'll be lucky if someone goes through it all for you very carefully.

Have you considered calling it directly from the Immediate pane and tracing the execution to see where it behaves differently from what you'd expect (Debugging in VBA)?
Nov 28 '11 #6

P: 78
I tried to debug and did not come back with any halts.

However, I noticed that I do not have the Microsoft DAO 3.6 Object Library activated under my VBA references. I tried to activate and it and get an error dialogue saying "Name conflicts with existing module, project, or object library." I do not have any other modules in the current database. I also tried to add the reference in a new database and received the same error.

Could this be the culprit?
Nov 29 '11 #7

Rabbit
Expert Mod 10K+
P: 12,421
Do those fields contain a lot of nulls? I don't remember if the code handled nulls. Also, you said your DOM field is a calculated field... like in a query? But you also said GENERAL is a table. Your calculated query field isn't going to exist in your table.
Nov 29 '11 #8

P: 78
The current dataset does not contain any nulls. DOM is in the table design view as a calculated datatype.

The recordset for the report comes from a simple select query.
Nov 29 '11 #9

P: 78
SOLVED!

I used the following code to calculate the median of the fields. Both fields in question have returned appropriate values in my first round of tests.

Expand|Select|Wrap|Line Numbers
  1. Function Median (tName As String, fldName As String) As Single
  2.   Dim MedianDB As DAO.Database
  3.   Dim ssMedian As DAO.Recordset
  4.   Dim RCount As Integer, i As Integer, x As Double, y As Double, _
  5.       OffSet As Integer
  6.   Set MedianDB = CurrentDB()
  7.   Set ssMedian = MedianDB.Openrecordset("SELECT [" & fldName & _
  8.             "] FROM [" & tName & "] WHERE [" & fldName & _ 
  9.             "] IS NOT NULL ORDER BY [" & fldName  & "];")
  10.   'NOTE: To include nulls when calculating the median value, omit
  11.   'WHERE [" & fldName & "] IS NOT NULL from the example.
  12.   ssMedian.MoveLast
  13.   RCount% = ssMedian.RecordCount
  14.   x = RCount Mod 2
  15.   If x <> 0 Then
  16.      OffSet = ((RCount + 1) / 2) - 2
  17.      For i% = 0 To OffSet
  18.         ssMedian.MovePrevious
  19.      Next i
  20.      Median = ssMedian(fldName)
  21.   Else
  22.      OffSet = (RCount / 2) - 2
  23.      For i = 0 To OffSet
  24.         ssMedian.MovePrevious
  25.      Next i
  26.      x = ssMedian(fldName)
  27.      ssMedian.MovePrevious
  28.      y = ssMedian(fldName)
  29.      Median = (x + y) / 2
  30.   End If
  31.   If Not ssMedian Is Nothing Then
  32.      ssMedian.Close
  33.      Set ssMedian = Nothing
  34.   End If
  35.   Set MedianDB = Nothing
  36. End Function
  37.  
I also needed to enter this into the Declarations

Expand|Select|Wrap|Line Numbers
  1. Option Explicit
Thanks for your help guys!!!
Nov 29 '11 #10

NeoPa
Expert Mod 15k+
P: 31,709
Good to hear. I assume the problem was related to your missing reference, which in turn went unnoticed due to the lack of the Option Explicit. There's a lesson there whichever way it turned out ;-)

For some more helpful tips that may help avoid such errors in future see When Posting (VBA or SQL) Code. It's particularly important when posting, but some of the ideas also help in the general development of code.
Nov 29 '11 #11

P: 78
I suspect you are correct, NeoPa.

Thanks NeoPA
Thanks Rabbit
Nov 29 '11 #12

Post your reply

Sign in to post your reply or Sign up for a free account.