Weighted Average IFS UDF

Question

I am trying to make a Weighted Average Ifs function with the capability of having up to three ifs. as it stands, the function only works when the optionality is removed and all arguments are filled by the user. When the function is run #Value! is returned when optional arguments are not filled. here is the complete code in question.

Function WeightedAvgIfs(ByVal values As Range, ByVal weights As Range, _
ByVal ConditionRange1 As Range, ByVal Condition1 As String, _
Optional ByVal ConditionRange2 As Range = Nothing, Optional ByVal Condition2 As String = "=ZZZ", _
Optional ByVal ConditionRange3 As Range = Nothing, Optional ByVal Condition3 As String = "=ZZZ") As Double

Dim ValuesArray(), WeightsArray(), Condition1Array(), Condition2Array(), Condition3Array() As Variant
Dim i As Long
Dim dsum As Double
Dim StringOperator As String
Dim Condition As Variant

ValuesArray = Range(values.Address(1, 1, xlA1, 1))
WeightsArray = Range(weights.Address(1, 1, xlA1, 1))
Condition1Array = Range(ConditionRange1.Address(1, 1, xlA1, 1))
Condition2Array = Range(ConditionRange2.Address(1, 1, xlA1, 1))
Condition2Array = Range(ConditionRange3.Address(1, 1, xlA1, 1))

'Condition 1
For i = LBound(ValuesArray) To UBound(ValuesArray)

    Select Case Left(Condition1, 2)
        Case Is = "<="
            StringOperator = "<="
            Condition = Val(Mid(Condition1, 3, Len(Condition1)))
        Case Is = ">="
            StringOperator = ">="
            Condition = Val(Mid(Condition1, 3, Len(Condition1)))
        Case Is = "<>"
            StringOperator = "<>"
            If IsNumeric(Mid(Condition1, 3, Len(Condition1))) And Not IsEmpty(Condition1) Then
                Condition = Val(Mid(Condition1, 3, Len(Condition1)))
            Else
                Condition = UCase(Mid(Condition1, 3, Len(Condition1)))
            End If
        
        Case Else
            Select Case Left(Condition1, 1)
                Case Is = "<"
                    StringOperator = "<"
                    Condition = Val(Mid(Condition1, 2, Len(Condition1)))
                Case Is = ">"
                    StringOperator = ">"
                    Condition = Val(Mid(Condition1, 2, Len(Condition1)))
                Case Is = "="
                    StringOperator = "="
                    If IsNumeric(Mid(Condition1, 2, Len(Condition1))) And Not IsEmpty(Condition1) Then
                        Condition = Val(Mid(Condition1, 2, Len(Condition1)))
                    Else
                        Condition = UCase(Mid(Condition1, 2, Len(Condition1)))
                    End If
            End Select
    End Select
    Select Case StringOperator
        Case Is = ">="
            If Condition1Array(i, 1) < Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = ">"
            If Condition1Array(i, 1) <= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<="
            If Condition1Array(i, 1) > Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<"
            If Condition1Array(i, 1) >= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Else
            Select Case StringOperator
                Case Is = "="
                    If IsNumeric(Condition1Array(i, 1)) And Not IsEmpty(Condition1Array(i, 1)) Then
                        If Val(Condition1Array(i, 1)) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition1Array(i, 1))) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
                Case Is = "<>"
                    If IsNumeric(Condition1Array(i, 1)) And Not IsEmpty(Condition1Array(i, 1)) Then
                        If Val(Condition1Array(i, 1)) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition1Array(i, 1))) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
            End Select
    End Select
    
Next i

If ConditionRange2 Is Nothing Then
    GoTo FinalCalc
End If

'Condition 2

For i = LBound(ValuesArray) To UBound(ValuesArray)

    Select Case Left(Condition2, 2)
        Case Is = "<="
            StringOperator = "<="
            Condition = Val(Mid(Condition2, 3, Len(Condition2)))
        Case Is = ">="
            StringOperator = ">="
            Condition = Val(Mid(Condition2, 3, Len(Condition2)))
        Case Is = "<>"
            StringOperator = "<>"
            If IsNumeric(Mid(Condition2, 3, Len(Condition2))) And Not IsEmpty(Condition2) Then
                Condition = Val(Mid(Condition2, 3, Len(Condition2)))
            Else
                Condition = UCase(Mid(Condition2, 3, Len(Condition2)))
            End If
        
        Case Else
            Select Case Left(Condition2, 1)
                Case Is = "<"
                    StringOperator = "<"
                    Condition = Val(Mid(Condition2, 2, Len(Condition2)))
                Case Is = ">"
                    StringOperator = ">"
                    Condition = Val(Mid(Condition2, 2, Len(Condition2)))
                Case Is = "="
                    StringOperator = "="
                    If IsNumeric(Mid(Condition2, 2, Len(Condition2))) And Not IsEmpty(Condition2) Then
                        Condition = Val(Mid(Condition2, 2, Len(Condition2)))
                    Else
                        Condition = UCase(Mid(Condition2, 2, Len(Condition2)))
                    End If
            End Select
    End Select
    Select Case StringOperator
        Case Is = ">="
            If Condition2Array(i, 1) < Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = ">"
            If Condition2Array(i, 1) <= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<="
            If Condition2Array(i, 1) > Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<"
            If Condition2Array(i, 1) >= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Else
            Select Case StringOperator
                Case Is = "="
                    If IsNumeric(Condition2Array(i, 1)) And Not IsEmpty(Condition2Array(i, 1)) Then
                        If Val(Condition2Array(i, 1)) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition2Array(i, 1))) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
                Case Is = "<>"
                    If IsNumeric(Condition2Array(i, 1)) And Not IsEmpty(Condition2Array(i, 1)) Then
                        If Val(Condition2Array(i, 1)) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition2Array(i, 1))) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
            End Select
    End Select
    
Next i
If ConditionRange3 Is Nothing Then
GoTo FinalCalc
End If

'Condition 3
For i = LBound(ValuesArray) To UBound(ValuesArray)

    Select Case Left(Condition3, 2)
        Case Is = "<="
            StringOperator = "<="
            Condition = Val(Mid(Condition3, 3, Len(Condition3)))
        Case Is = ">="
            StringOperator = ">="
            Condition = Val(Mid(Condition3, 3, Len(Condition3)))
        Case Is = "<>"
            StringOperator = "<>"
            If IsNumeric(Mid(Condition3, 3, Len(Condition3))) And Not IsEmpty(Condition3) Then
                Condition = Val(Mid(Condition3, 3, Len(Condition3)))
            Else
                Condition = UCase(Mid(Condition3, 3, Len(Condition3)))
            End If
        
        Case Else
            Select Case Left(Condition3, 1)
                Case Is = "<"
                    StringOperator = "<"
                    Condition = Val(Mid(Condition3, 2, Len(Condition3)))
                Case Is = ">"
                    StringOperator = ">"
                    Condition = Val(Mid(Condition3, 2, Len(Condition3)))
                Case Is = "="
                    StringOperator = "="
                    If IsNumeric(Mid(Condition3, 2, Len(Condition3))) And Not IsEmpty(Condition3) Then
                        Condition = Val(Mid(Condition3, 2, Len(Condition3)))
                    Else
                        Condition = UCase(Mid(Condition3, 2, Len(Condition3)))
                    End If
            End Select
    End Select
    Select Case StringOperator
        Case Is = ">="
            If Condition3Array(i, 1) < Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = ">"
            If Condition3Array(i, 1) <= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<="
            If Condition3Array(i, 1) > Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<"
            If Condition3Array(i, 1) >= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Else
            Select Case StringOperator
                Case Is = "="
                    If IsNumeric(Condition3Array(i, 1)) And Not IsEmpty(Condition3Array(i, 1)) Then
                        If Val(Condition3Array(i, 1)) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition3Array(i, 1))) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
                Case Is = "<>"
                    If IsNumeric(Condition3Array(i, 1)) And Not IsEmpty(Condition3Array(i, 1)) Then
                        If Val(Condition3Array(i, 1)) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition3Array(i, 1))) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
            End Select
    End Select
    
Next i

FinalCalc:

dsum = Application.WorksheetFunction.Sum(WeightsArray)

For i = LBound(WeightsArray) To UBound(WeightsArray)
    WeightsArray(i, 1) = WeightsArray(i, 1) / dsum
Next i
For i = LBound(ValuesArray) To UBound(ValuesArray)
    ValuesArray(i, 1) = ValuesArray(i, 1) * WeightsArray(i, 1)
Next i

WeightedAvgIfs = Application.WorksheetFunction.Sum(ValuesArray)
End Function

BTW and not your problem but one does not need to create an address string just to translate that back to a range. for example `ValuesArray = Range(values.Address(1, 1, xlA1, 1))` can just be: `ValuesArray = values.Value` — Scott Craner, Feb 23 '22 at 19:29
Cool thanks i just tested it and youre right! i guess that makes filling arrays a little easier. — Phriholio, Feb 23 '22 at 19:35
also here is code I created for a TEXTJOINIFS, which uses a paramarray https://stackoverflow.com/questions/56858571/merge-values-of-column-b-based-on-common-values-on-column-a again not your problem but maybe another way to think about it. — Scott Craner, Feb 23 '22 at 19:35
your error is happing here: `Condition2Array = Range(ConditionRange2.Address(1, 1, xlA1, 1))` if `ConditionRange2` is nothing it has no address. You need to add ifs to those so you do not try to fill an array from a non existent range. — Scott Craner, Feb 23 '22 at 19:37
If you call your function from a Sub then you can debug the problem instead of just getting #Value! in a cell. — Tim Williams, Feb 23 '22 at 19:37
FYI doing this `ValuesArray = Range(values.Address(1, 1, xlA1, 1))` also runs the risk of transferring the range to an entirely different sheet, if `values` happens to be on a different sheet from the ActiveSheet. — Tim Williams, Feb 23 '22 at 19:41
@TimWilliams wouldn't the fact that the address is returning the external reference overcome that issue? But, as stated it is not needed. — Scott Craner, Feb 23 '22 at 19:43
thank you for the debug advice tim. I am at work right now once i finish what i am doing i will test Scotts solution. Thank you for all the quick advice. — Phriholio, Feb 23 '22 at 19:44
@ScottCraner - Yes you're right - I missed that part. Still , the whole thing is not required at all in this case as you pointed out.. — Tim Williams, Feb 23 '22 at 19:47
You guys are true stack overflow heros. it not works with the fixes above. @ScottCraner I like the ability to use an unlimited amount of conditions in the ifs. Is that what the paramarray does? I believe the best advice i can take away here is the new found ability to debug functions. Tim and Scott i would buy you a beer if i could. — Phriholio, Feb 23 '22 at 20:00

Tim Williams · Answer 1 · 2022-02-24T05:42:46.967

Here's a paramarray version with some other optimizations. I did skip your IsNumeric/Empty checks but general idea is there...

'opts = 1 or more pairs of Range, Condition values
Function WeightedAvgIfs(ByVal values As Range, ByVal weights As Range, ParamArray opts()) As Double

    Dim ValuesArray(), WeightsArray(), CondArray() As Variant
    Dim i As Long, opt As Long
    Dim dsum As Double
    Dim StringOperator As String
    Dim Cond As Variant, op As String, condVal, bOK As Boolean
    
    ValuesArray = values.Value
    WeightsArray = weights.Value
    'loop over any condition range + value pairs provided
    For opt = LBound(opts) To UBound(opts) Step 2
        CondArray = opts(opt).Value          'read the criteria range values
        Cond = Trim(opts(opt + 1))           'read the criteria
        op = Left(Cond, 2)                   'extract the criteria operator
        op = IIf(op = "<=" Or op = ">=" Or op = "<>", op, Left(op, 1))
        Cond = Trim(Right(Cond, Len(Cond) - Len(op))) 'extract the criteria value
        For i = LBound(ValuesArray) To UBound(ValuesArray)
            If ValuesArray(i, 1) <> 0 And WeightsArray(i, 1) <> 0 Then 'check not already excluded
                bOK = False
                condVal = CondArray(i, 1)
                Select Case op
                    Case "<=": bOK = (condVal <= Cond)
                    Case "<": bOK = (condVal < Cond)
                    Case ">=": bOK = (condVal >= Cond)
                    Case ">": bOK = (condVal > Cond)
                    Case "=": bOK = (condVal = Cond)
                    Case "<>": bOK = (condVal <> Cond)
                End Select
                If Not bOK Then 'filtered out in this run?
                    ValuesArray(i, 1) = 0
                    WeightsArray(i, 1) = 0
                End If
            End If
        Next i
    Next opt
    
    dsum = Application.WorksheetFunction.Sum(WeightsArray)
    For i = LBound(ValuesArray) To UBound(ValuesArray)
        ValuesArray(i, 1) = ValuesArray(i, 1) * (WeightsArray(i, 1) / dsum)
    Next i
    WeightedAvgIfs = Application.WorksheetFunction.Sum(ValuesArray)
End Function

Weighted Average IFS UDF

1 Answers1