I'm writing my first function and I'm creating a function for a weighted average formula.

This works fine when I use it as a sub and define the values, but I'm getting this error when testing the function in the immediate window.

I've tried playing around with the data types to no avail.

Any help would be much appreciated.

enter image description here

Public Function WeightedAverage(data() As Range, values() As Range, TotalValue As Range) As Double

Dim i As Integer

Dim Sum As Variant

    For i = 1 To UBound(data)
    
    Sum = Sum   values(i, 1) / TotalValue * data(i, 1)
    
    Next i
    
    WA = Sum / UBound(data)
    
End Function

enter image description here

CodePudding user response：

As @Skin mentioned you can revise your code a little bit. I removed the brackets in your parameter section. Further you should call the function within a cell and assign each parameter to a cell/a range of cells.

The variable "WA" is not defined anywhere in your code. That causes maybe your error. To get a return value from a user defined function (UDF) you should assign the variable "sum" to the functions name.

Public Function WeightedAverage( _
    data As Range, _
    values As Range, _
    TotalValue As Range _
        ) As Double

    Dim i As Integer
    
'You need containers for your parameters, which can be more then one cell

    Dim arrData As Variant: arrData = data
    Dim arrValues As Variant: arrValues = values
    
    Dim Sum As Double
    
'Both arrays need the same size, optional, I thought that might help a little bit
    
    If UBound(arrData, 1) <> UBound(arrValues) Then Exit Function

    For i = 1 To UBound(arrData, 1)

    Sum = Sum   arrValues(i, 1) / TotalValue * arrData(i, 1)

    Next i

'Assign the variable "sum" to the functions name

    WeightedAverage = Sum / UBound(arrData, 1)

End Function

CodePudding user response：

Weighted Average UDF

• Whatever you're doing here, according to this link, that's not how you calculate the weighted average (the last parameter seems redundant, dividing in the loop is wrong).
• The suggested SUMPRODUCT/SUM formula solution in the provided link will fail if there are cells not containing numeric values while the following function will ignore (skip) those cells.

Weighted Average

Option Explicit

Function WeightedAverage( _
    ByVal ScoreColumnRange As Range, _
    ByVal WeightColumnRange As Range) _
As Double
    
    ' Compare the number of rows and use the smaller number.
    Dim rCount As Long: rCount = ScoreColumnRange.Rows.Count
    Dim wrCount As Long: wrCount = WeightColumnRange.Rows.Count
    If wrCount < rCount Then rCount = wrCount
    
    ' Create the references to the column ranges.
    Dim srg As Range: Set srg = ScoreColumnRange.Cells(1).Resize(rCount)
    Dim wrg As Range: Set wrg = WeightColumnRange.Cells(1).Resize(rCount)
    
    ' Write the values from the column ranges to arrays.
    Dim sData As Variant, wData As Variant
    If rCount = 1 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
        ReDim wData(1 To 1, 1 To 1): wData(1, 1) = wrg.Value
    Else
        sData = srg.Value
        wData = wrg.Value
    End If
    
    ' Declare additional variables to be used in the For...Next loop.
    Dim sVal As Variant, wVal As Variant ' Current Values
    Dim r As Long ' Rows Counter
    Dim tWeight As Double ' Total Weight
    Dim tProduct As Double ' Total Sum
    
    ' Calculate the total weights and the total products.
    For r = 1 To UBound(sData, 1)
        sVal = sData(r, 1)
        If IsNumeric(sVal) Then ' prevent invalid score
            wVal = wData(r, 1)
            If IsNumeric(wVal) Then ' prevent invalid weight
                tWeight = tWeight   wVal
                tProduct = tProduct   sVal * wVal
            End If
        End If
    Next r
    If tWeight = 0 Then Exit Function ' all were invalid
    
    ' Calculate and return the weighted average (the result).
    WeightedAverage = tProduct / tWeight ' maybe you want to round?

End Function

Your Code Revised

Function WeightedAverage( _
    ByVal DataColumnRange As Range, _
    ByVal ValuesColumnRange As Range, _
    ByVal TotalValue As Double) _
As Double
    
    ' Compare the number of rows and use the smaller number.
    Dim rCount As Long: rCount = DataColumnRange.Rows.Count
    Dim vrCount As Long: vrCount = ValuesColumnRange.Rows.Count
    If vrCount < rCount Then rCount = vrCount
    
    ' Create the references to the column ranges.
    Dim drg As Range: Set drg = DataColumnRange.Cells(1).Resize(rCount)
    Dim vrg As Range: Set vrg = ValuesColumnRange.Cells(1).Resize(rCount)
    
    ' Write the values of the column ranges to arrays.
    Dim dData As Variant, vData As Variant
    If rCount = 1 Then
        ReDim dData(1 To 1, 1 To 1): dData(1, 1) = drg.Value
        ReDim vData(1 To 1, 1 To 1): vData(1, 1) = vrg.Value
    Else
        dData = drg.Value
        vData = vrg.Value
    End If
    
    ' Declare additional variables to be used in the For...Next loop.
    Dim dVal As Variant, vVal As Variant ' Current Values
    Dim r As Long ' Rows Counter
    Dim tCount As Long ' Total Count
    Dim Total As Double ' Total Value
    
    ' Calculate the Total? (there should be a math term for it)
    For r = 1 To UBound(dData, 1)
        dVal = dData(r, 1)
        If IsNumeric(dVal) Then ' prevent invalid data
            vVal = vData(r, 1)
            If IsNumeric(vVal) Then ' prevent invalid value
                tCount = tCount   1
                Total = Total   dVal * vVal / TotalValue
            End If
        End If
    Next r
    
    If tCount = 0 Then Exit Function ' all were invalid
    
    ' Calculate and return the weighted average (the result).
    WeightedAverage = Total / tCount ' maybe you want to round?

End Function