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

>
Want a good read? Try The Summer of His Life (available on Amazon!)

GetMedianIF function for Excel

 Post Reply Post Reply
Author
Message Reverse Sort Order
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
>
Want a good read? Try The Summer of His Life (available on Amazon!)

Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 12.03
Copyright ©2001-2019 Web Wiz Ltd.