Roger's Access Library Homepage
Forum Home Forum Home > Other Download Libraries > MS Access MVP Libraries > Long, Crystal
  New Posts New Posts RSS Feed - GetMedianIF function for Excel
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


Please consider donating $1 per sample downloaded, (find out why here)

GetMedianIF function for Excel

 Post Reply Post Reply
Author
Message
Crystal Long View Drop Down
Microsoft MVP
Microsoft MVP


Joined: 21 May 2012
Location: Colorado
Status: Offline
Points: 35
Post Options Post Options   Thanks (0) Thanks(0)   Quote Crystal Long Quote  Post ReplyReply Direct Link To This Post Topic: GetMedianIF function for Excel
    Posted: 04 Jun 2012 at 1:28pm
Excel has functions to Sum and Average for a range using criteria ... but there is no built-in function to get a median value using criteria, so I wrote one.


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


Feedback is appreciated, thank you

Warm Regards,
Crystal

Microsoft MVP
remote programming and training

Access Basics by Crystal
http://www.AccessMVP.com/strive4peace
Free 100-page book that covers essentials in Access

http://www.YouTube.com/LearnAccessByCrystal

 *
   (: have an awesome day :)
 *
Warm Regards,
Crystal
Microsoft MVP
Remote Training & Programming
Let's Connect and Build Together

http://www.AccessMVP.com/strive4peace
http://YouTube.com/LearnAccessByCrystal
~have an awesome day ~
Back to Top
Sponsored Links


Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down