I realize this is an old post, but since it came up in my quest to find a VBA script to calculate the median from a range of values (values in bins) like the original poster asked for, I thought I'd post my solution to share with others.
I a beginner when it comes to VB so its possible there are easier way to do some of the things I did, but I have include comments to document what each step of my script is doing.
You will need to have at least 2 columns in your spreadsheet/range of values. The first column must be the beginning of the range (i.e. if it is for income values with the first two ranges
$0 to $9,9999 $10,000 to $14,9999
then the first 2 rows of the first colmun should be 0 and 10000). Example input:
The script prompts for the input range of values. You can have multiple columns of population that you want to get the median for. It will also prompt for the cell you want to put the output, median value(s), into.
here is the script
Sub GetMedian()
'have user select the range for the input data
'the first column must be the number for the beginning of the range
'for the bin
'the second column (can have more than one if doing mulitple areas)
'has the population for that bin
Dim UserRange As Range
Prompt = "Select the input range." & vbCrLf & _
vbCrLf & "The first column must be the beginning of the " & _
vbCrLf & "range for the bin. The second column has the " & _
vbCrLf & "population for the bin. You can have more than " & _
vbCrLf & "one column of populations." & _
vbCrLf
Title = "Select a range"
'Display the Input Box
Set UserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=Selection.Address, _
Type:=8) 'Range selection
'get current selected range
Dim myString As String
'myString = Selection.Address
myString = UserRange.Address
'go though the columns
'how many columns are in the UserRange?
NoOfCol = Range(myString).Columns.count
'get the output range from the user
Dim OutRange As Range
Prompt = "Select a cell for the output" & vbCrLf & _
vbCrLf & "Values for multiple medians will be " & _
vbCrLf & "returned in a row beginning with the " & _
vbCrLf & "selected cell " & _
vbCrLf
' Display the Input Box
On Error Resume Next
Set OutRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Range selection
'now get to work
'for loop starts with the first population column (2nd in range)
'end is how many pop columns are in the user input range
For col = 2 To NoOfCol
'set range as an array
Dim myArray() As Variant
myArray = Range(myString).Value
'get sum of pop and divide by 2 to get halfpoint
'initialize a total to aggregate values
popSum = 0
For i = 1 To UBound(myArray)
popSum = popSum + myArray(i, col)
Next
'MsgBox popSum
MedianIndex = popSum / 2
'MsgBox MedianIndex
'initialize for running total
runtotal = 0
'step through each row
For i = 1 To UBound(myArray)
'add the cumulative total pop
runtotal = runtotal + myArray(i, col)
'check if the runtotal exceeds the medianIndex
If runtotal > MedianIndex Then
'get the cumulative pop for the bin just before we exceeded
'so subtract the current array value from the current runTotal
prevTotal = runtotal - myArray(i, col)
'determine how much into the bin it is to reach the medianIndex
howMany = MedianIndex - prevTotal
'get the pop value in the previous bin
Binpop = myArray(i, col)
'determine the pct of how far into this bin the medianIndex falls
pctInto = howMany / Binpop
'determine the span of the bin
'and multiply it by the pct into the bin
MultiSpan = (myArray(i, 1) - myArray(i - 1, 1)) * pctInto
'calculate the median by adding the result to
'the number for the beginning of hte range
Median = myArray(i, 1) + MultiSpan
'put the median in the output cell
OutRange.Offset(0, col - 2).Value = Median
Exit For
End If
Next
Next
End Sub