Function GetMedianIF( _ pValueRange As Range _ , pCritColumn As String _ , pCrit As Variant _ ) As Variant 'Crystal 120528
'return the Median value in a range that meets criteria 'example useage in a cell: ' =GetMedianIF(E2:E200,"K","Some Name") ' ' E2:E200 is the range to look at to get the median value ' K is the column that has the criteria ' "Some Name" is the value to compare to. This can be a cell reference. '
Dim arrValues() ReDim arrValues(0) arrValues(0) = -9999999 Dim nNumValues As Long Dim nRow As Long _ , nColValue As Long _ , nRow1 As Long _ , nRows As Long nRow1 = pValueRange.Row nRows = pValueRange.Rows.Count nColValue = pValueRange.Column
For nRow = nRow1 To (nRow1 + nRows) 'see if criteria is met If Range(pCritColumn & nRow) = pCrit Then If arrValues(0) <> -9999999 Then ReDim Preserve arrValues(UBound(arrValues) + 1) End If arrValues(UBound(arrValues)) = Cells(nRow, nColValue) End If Next nRow If arrValues(0) = -9999999 Then 'uncomment next line if you want to return a message if there is no data 'GetMedianIF = "no data" Exit Function End If If UBound(arrValues) = 0 Then 'there is only one value GetMedianIF = arrValues(0) Exit Function End If 'sort the array SortArray arrValues
nNumValues = UBound(arrValues) + 1
'see if the number of values is even or odd If nNumValues / 2 = nNumValues \ 2 Then 'number is even 'average 2 middle values GetMedianIF = (arrValues(nNumValues \ 2 - 1) + arrValues(nNumValues \ 2)) / 2 Else 'number of values is odd -- take the middle number GetMedianIF = arrValues(nNumValues \ 2 - 1) End If
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Public Sub SortArray(ByRef varArray() As Variant) 'Sorts a single element array 'based on code written by Brent Spaulding (datAdrenaline) 'Crystal 120528
Dim varElement As Variant _ , nLeft As Long _ , i As Long 'Bubble sort the array If UBound(varArray) > 0 Then nLeft = UBound(varArray) Do Until nLeft = 0 For i = LBound(varArray) To nLeft - 1 If varArray(i) > varArray(i + 1) Then varElement = varArray(i) varArray(i) = varArray(i + 1) varArray(i + 1) = varElement End If Next i nLeft = nLeft - 1 Loop End If End Sub
|