Weighted Median - UDF for array?

Question

I'm an admitted newb when it comes to playing around in VBA among many other things excel/code/etc. I was poking around trying to find a way to account for occurrence weighting when calculating a Median (one column for value occurrence, once for value) and I found an older UDF that worked well.

Now I may be getting a little greedy but I'm trying to process a pretty substantial amount of information and the quickest way to do that would be to do WeightedMedian only when the values are identified by a label in a third column.

Occurr. Cost    Store Name
1   9.99    Charlie
4   15  Charlie
5   8   Charlie
6   10  Romeo
9   12  Delta
2   15  Romeo
3   8   Romeo
4   9.99    Delta
6   15  Delta
1   8   Delta

I tried this {=WeightedMedian(IF($C$2:$C$12=$D2,$B$2:$B$12),IF($C$2:$C$12=$D2,$A$2:$A$12))} In the hopes of returning the two necessary arrays to serve the ValueRange and WeightRange of the WeightedMedian. However I just get the #Value error. Any thoughts on how to fix it? Original UDF listed below.

*UDF*

Function WeightedMedian(ValueRange As Range, WeightRange As Range)

Dim MedianArray()

On Error GoTo WrongRanges

ArrayLength = Application.Sum(WeightRange)
ReDim MedianArray(1 To ArrayLength)

Counter = 0
ArrayCounter = 0

For Each ValueRangeCell In ValueRange

LoopCounter = LoopCounter + 1
FirstArrayPos = ArrayCounter + 1
ArrayCounter = ArrayCounter + Application.Index(WeightRange, LoopCounter)

For n = FirstArrayPos To ArrayCounter

MedianArray(n) = ValueRangeCell.Value

Next

Next
WeightedMedian = Application.Median(MedianArray)
Exit Function

WrongRanges:
WeightedMedian = CVErr(2042)
End Function

Answer 1

Go to the Tools => Options.. and tick "Require Variable Declaration" to automatically add Option Explicit to the top of every module you create in future. You will be thanking me forever.

Without needing Array formula:

The following takes two more parameters, StoreRange and store.

Function converts the input ranges to variant arrays which it loops through.

Probably slower than @AxelRichter answer but doesn't require CSE entry.

Function WeightedMedianArrays(ValueRange As Range, _
    WeightRange As Range, _
    StoreRange As Range, _
    store As String) As Single
'Assumes all ranges start on same row and are same length
Dim MedianArray()
Dim Weights() As Variant
Dim Vals() As Variant
Dim Stores() As Variant
Dim FirstArrayPos As Long
Dim n As Long
Dim x As Long


    Weights = WeightRange
    Vals = ValueRange
    Stores = StoreRange
    For x = 1 To UBound(Vals)
        If Stores(x, 1) = store Then
            ReDim Preserve MedianArray(1 To FirstArrayPos + Weights(x, 1))
            For n = 1 To Weights(x, 1)
                MedianArray(FirstArrayPos + n) = Vals(x, 1)
            Next
            FirstArrayPos = FirstArrayPos + Weights(x, 1)
        End If
    Next
    WeightedMedianArrays = Application.Median(MedianArray)
End Function

Result

Answer 2

I have just changed your function to work as the following array formula:

{=WeightedMedian(IF($C$2:$C$12=$D2,$B$2:$B$12),IF($C$2:$C$12=$D2,$A$2:$A$12))}

As comments mentioned the {IF($C$2:$C$12=$D2,$B$2:$B$12)} and the other IF in array context will not result in ranges but in arrays. So the Function must handle them as such and not as ranges.

Note, the Weights array as the result of {IF($C$2:$C$12=$D2,$A$2:$A$12)} is a two dimensional array. The Values as the result of {IF($C$2:$C$12=$D2,$B$2:$B$12)} also is. But because of the For Each we need not pay attention on that.

UDF:

Function WeightedMedian(Values As Variant, Weights As Variant) As Variant

 Dim MedianArray()

 On Error GoTo WrongRanges

 ArrayLength = Application.Sum(Weights)
 ReDim MedianArray(1 To ArrayLength)

 Counter = 0
 ArrayCounter = 0

 For Each sValue In Values

  LoopCounter = LoopCounter + 1
  FirstArrayPos = ArrayCounter + 1
  ArrayCounter = ArrayCounter + Weights(LoopCounter, 1)

  For n = FirstArrayPos To ArrayCounter

   MedianArray(n) = sValue

  Next

 Next

 WeightedMedian = Application.Median(MedianArray)
 Exit Function

WrongRanges:
 WeightedMedian = CVErr(2042)
End Function

Result: