Excel should have a DMEDIAN function

J

Jim Cone

Barb,

From the Excel help file...

Some database and list management worksheet functions have names that begin with the letter "D."
These functions, also known as Dfunctions, have three arguments: database, field, criteria.
The database argument is the range that contains your list.
You must include the row that contains the column labels in the range.
The field argument is the label for the column you want to summarize.
The criteria argument is the range that contains a condition you specify.


DAVERAGE worksheet function
DCOUNT worksheet function
DCOUNTA worksheet function
DGET worksheet function
DMAX worksheet function
DMIN worksheet function
DPRODUCT worksheet function
DSTDEV worksheet function
DSTDEVP worksheet function
DSUM worksheet function
DVAR worksheet function
DVARP worksheet function
GETPIVOTDATA worksheet function


Jim Cone
San Francisco, USA
 
B

Barb R.

Thanks for the info. The version of Excel I have on this computer provides
no information on this function.
 
A

andy

DMEDIAN said:
how come excel doesn't have dmedian . . . what the hell?
Click to expand...


Hi there, my friend wrote a DMEDIAN code for Excel users:

Function DMEDIAN(Database As Range, Field As String, Criteria As
Range)

' Check if database is valid, each column has unique name
' Check if field is valid, there must exist a column named as Field
specified
Dim icol_dest As Integer
icol_dest = FindColumn(Database, Field)
If icol_dest = -1 Then
MsgBox "Something wrong"
Exit Function
End If

' Check if each criterion is valid
Dim cr_count As Integer

cr_count = Criteria.Columns.Count
ReDim ic_cr(cr_count) As Integer
For I = 1 To cr_count
ic_cr(I) = FindColumn(Database, Criteria.Cells(1, I))
Next I

Dim valid As Boolean
Dim errMsg As String
valid = True
errMsg = ""
For I = 1 To cr_count
If ic_cr(I) = -1 Then
valid = False
errMsg = errMsg + Criteria.Cells(1, I) + ","
End If
Next I
If Not valid Then
MsgBox "Criteria have errors " + Left(errMsg, Len(errMsg) - 1) + "
do not exist!"
Exit Function
End If

Dim inset As Boolean
Dim cdatai As Integer
ReDim dati(Database.Rows.Count - 1)
cdatai = 0
For irdb = 2 To Database.Rows.Count
inset = True
' Check each row(record)
For iccr = 1 To cr_count
' Check each criterion is true
Dim numeric As Boolean
If Criteria.Cells(2, iccr) "" Then
numeric = IsNumeric(Criteria(2, iccr))

Dim str_formula As String
str_formula = Database(irdb, ic_cr(iccr)).Text

If Left(Criteria(2, iccr).Text, 1) "" And Left(Criteria(2,
iccr).Text, 1) "" Then
If (numeric) Then
str_formula = str_formula + "=" + Criteria(2,
iccr).Text
Else
str_formula = """" + str_formula + """ = """ +
Criteria(2, iccr).Text + """"
End If
Else
str_formula = str_formula + Criteria(2, iccr)
End If


If Evaluate(str_formula) = False Then
inset = False
Exit For
End If
End If

Next

If inset = True Then
cdati = cdati + 1
dati(cdati) = Database(irdb, icol_dest)
End If
Next

For I = 2 To cdati
For J = 1 To I - 1
If dati(J) dati(I) Then
Tmp = dati(J)
dati(J) = dati(I)
dati(I) = Tmp
End If
Next J
Next I

If cdati Mod 2 = 1 Then
DMEDIAN = dati(Int(cdati / 2) + 1)
Else
DMEDIAN = (dati(cdati / 2) + dati(cdati / 2 + 1)) / 2
End If

End Function

Function eval(c1 As Range, c2 As Range) As Boolean

Dim str_cr As String
str_cr = Left(c2.Text, 1)
If str_cr = "" Then
If Left(c2.Text, 2) = "=" Then
If (c1 = c2) Then
eval = True
Else
eval = False
End If

ElseIf Left(Criteria(2, iccr).Text, 2) = "" Then


End If
ElseIf str_cr = "" Then
Else
End If

End Function

Function FindColumn(Database As Range, Field As String) As Integer

FindColumn = -1
For I = 1 To Database.Columns.Count
If Field = Database(1, I) Then
FindColumn = I
Exit For
End If
Next

End Function


**************
I hope it is helpful!

Good luck!

Andy
 
Top