Subset Percentile Function

[Anson]

I am using Excel 97 and am try to write a function to calculate the percentile based on criteria (sort of like how DMAX, DSUM work). I have tried it all day today with little success. Has someone here tried to write it? If so could you share the codes with me? This is what I have so far:

'------------------------------------------------------
Function DPercentile(DataRng As Range, CriRng As Range, _
Criteria As String, Percentile As Double)

Dim ArrSelect()
Dim iRng As Integer, NumSelect As Integer, NumLoc As Double
Dim LValue As Double, HValue As Double
Dim LNum As Integer, HNum As Integer
Dim iCount As Integer

'On Error GoTo ErrMgr
'Assign N/A if data and criteria ranges have different length
If DataRng.Count <> CriRng.Count Then
DPercentile = "#N/A"

Else
NumSelect = 0
'Run through each cell in DataRng
For iRng = 1 To DataRng.Count
'Add to list if matches criteria and non-blank
If CriRng(iRng, 1) = Criteria And DataRng(iRng, 1) <> "" Then
ReDim Preserve ArrSelect(NumSelect)
ArrSelect(NumSelect) = DataRng(iRng, 1)
NumSelect = NumSelect + 1
End If
Next iRng

Call BubbleSort(ArrSelect)

NumLoc = Percentile * (NumSelect - 1)

'Case 1 if the number is exact
If Fix(NumLoc) = NumLoc Then
DPercentile = ArrSelect(NumLoc)

'Case 2 if the number is between two number on the list
Else
LNum = 0: LValue = ArrSelect(Fix(NumLoc))
HNum = 0: HValue = ArrSelect(Fix(NumLoc) + 1)

'Count number of upper limit duplicates
For iCount = 0 To NumSelect - 1
If ArrSelect(iCount) = ArrSelect(Fix(NumLoc)) Then _
LNum = LNum + 1
If ArrSelect(iCount) = ArrSelect(Fix(NumLoc) + 1) Then _
HNum = HNum + 1
Next iCount

'Case 2a:
'If both Upper and Lower numbers have the same number of duplicates
If HNum = LNum Then
DPercentile = ((HValue - LValue) * Percentile) + LValue

Else

'Case 2b:
'Does't work
DPercentile = (Percentile * LValue + (1 - Percentile) * HValue)

'DPercentile = _
((HValue - LValue) * Abs(Percentile - 0.5) * 2) + LValue

End If

End If

End If

Exit Function

ErrMgr:
DPercentile = "#N/A"

End Function