Excel VBA function weighted average code -- how can I improve this?

NucNerd 0
Viewed 43

I need to write a function that takes a range of values (X) and their associated uncertainties (E) and outputs a weighted average. However, I can't get the function to loop over the array without producing a value error (#VALUE!). I'd also like it to just return the value of X if only one cell is entered as an input for X. Here is where I'm at thus far:

' Calculates the weighted average of arrays of values, X, and their errors, E
Option Explicit
Function WAV(X As Variant, E As Variant) As Double
    ' Update values upon changing spreadsheet
    Application.Volatile
    
    ' Test if we have an array or not
    If IsArray(X) And IsArray(E) Then
        Dim W As Double
        Dim WX As Double
        
        W = 0
        WX = 0
        WAV = 20
        
        For myrow = LBound(X,1) To UBound(X,1)
            For mycol = LBound(X, 2) To UBound(X, 2)
            'Test if X and E are both numbers and E > 0
                If (Application.WorksheetFunction.IsNumber(X(myrow, mycol)) = True) And (Application.WorksheetFunction.IsNumber(E(myrow, mycol)) = True) Then
                    If E(myrow, mycol) > 0 Then
                        W = W + 1 / (E(myrow, mycol) ^ 2)
                        WX = WX + X(myrow, mycol) / (E(myrow, mycol) ^ 2)
                    End If
                End If
            Next mycol
        Next
        
        If W > 0 Then
            WAV = WX / W
        End If
    Else
        WAV = X
    End If
End Function

I have wrestled with this for several hours, but to no avail. I'm also a beginner with VBA so I suspect I have made a stupid mistake somewhere. Any help would be appreciated.

function vba excel
1 Answers

Thanks to both BigBen and ScottCraner for their help in answering this question. Here is a working solution incorporating both of their suggestions:

Option Explicit
Function WAV(X As Variant, E As Variant) As Double
    ' Update values upon changing spreadsheet
    Application.Volatile
    
    ' Test if we have an array or not
    If IsArray(X) And IsArray(E) Then
        ' Change all the ranges into arrays
        Dim XArr() As Variant
        Dim EArr() As Variant
        Dim WArr() As Variant
        
        ' Assign the array values
        XArr = X.Value
        EArr = E.Value
        
        ' Resize the weighting array
        ReDim WArr(LBound(EArr, 1) To UBound(EArr, 1), LBound(EArr, 2) To UBound(EArr, 2))
        
        ' Calculate square inverses of errors
        For myrow = LBound(EArr, 1) To UBound(EArr, 1)
            For mycol = LBound(EArr, 2) To UBound(EArr, 2)
                WArr(myrow, mycol) = 1 / (EArr(myrow, mycol) ^ 2)
            Next mycol
        Next myrow
        
        ' Now calculate the weighted average using sumproduct function
        Dim W As Double
        Dim WX As Double
        
        WX = WorksheetFunction.SumProduct(XArr, WArr)
        W = WorksheetFunction.SumProduct(WArr)
        
        ' Return weighted average
        WAV = WX / W
        
    Else
        ' Return the weighted average
        WAV = X
    End If
End Function
NucNerd0
Related