UDF returning an Error

Juggler_IN

Active Member
Joined
Nov 19, 2014
Messages
349
Office Version
  1. 2003 or older
Platform
  1. Windows
Hi,

When I am passing a range to the below UDF, say A1=CorrelationCoefficient(B1:C100, 1, 2, 0) I am getting an VALUE error. Any reason why?

The code is:
Code:
Public Function CorrelationCoefficient(MyArray() As Double, Optional asX As Long = -1, _
                                       Optional asY As Long = -1, Optional asWeight As Long = 0) As Double


    Dim i As Long
    Dim SumX As Double
    Dim SumX2 As Double
    Dim SumY As Double
    Dim SumY2 As Double
    Dim SumXY As Double
    Dim SumW As Double
    Dim weight As Double
    Dim Numerator As Double
    Dim Denominator As Double


    On Error GoTo ErrHandler_CorCoef




    'can correlation coefficient be calculated?
    If MultiDimensional(MyArray) = True And UBound(MyArray, 1) > 1 Then


        'correct weightfactor?
        If asWeight < 0 Then asWeight = 0
        If asWeight > 4 Then asWeight = 0




        'initialise
        SumX = 0
        SumX2 = 0
        SumY = 0
        SumY2 = 0
        SumXY = 0
        SumW = 0


        'determine which columns need to be correlated
        If asX < 0 Then asX = 0
        If asX > UBound(MyArray, 2) Then asX = 0
        If asY < 0 Then asY = 1
        If asY > UBound(MyArray, 2) Then asY = 1


        'calculate SumX, SumX2, SumY, SumY2 and SumXY
        For i = 0 To UBound(MyArray, 1)
            Select Case asWeight
            Case 0    'equal weighting
                weight = 1
            Case 1    '1/x
                If MyArray(i, asX) <> 0 Then
                    weight = Abs(1 / MyArray(i, asX))
                Else
                    weight = 1    'discutable
                End If
            Case 2    '1/x^2
                If (MyArray(i, asX) * MyArray(i, asX)) <> 0 Then
                    weight = Abs(1 / (MyArray(i, asX) * MyArray(i, asX)))
                Else
                    weight = 1    'discutable
                End If
            Case 3    '1/y
                If MyArray(i, asY) <> 0 Then
                    weight = Abs(1 / MyArray(i, asY))
                Else
                    weight = 1    'discutable
                End If
            Case 4    '1/y^2
                If (MyArray(i, asY) * MyArray(i, asY)) <> 0 Then
                    weight = Abs(1 / (MyArray(i, asY) * MyArray(i, asY)))
                Else
                    weight = 1    'discutable
                End If
            End Select
            SumX = SumX + MyArray(i, asX) * weight
            SumX2 = SumX2 + MyArray(i, asX) * MyArray(i, asX) * weight
            SumY = SumY + MyArray(i, asY) * weight
            SumY2 = SumY2 + MyArray(i, asY) * MyArray(i, asY) * weight
            SumXY = SumXY + MyArray(i, asX) * MyArray(i, asY) * weight
            SumW = SumW + weight
        Next i


        Numerator = SumXY - (SumX * SumY / SumW)
        Denominator = Sqr((SumX2 - SumX * SumX / SumW) * (SumY2 - SumY * SumY / SumW))


        If Denominator <> 0 Then
            CorrelationCoefficient = Numerator / Denominator
        Else
            '
        End If


    Else


        CorrelationCoefficient = 99    ' Error value


    End If


    Exit Function




ErrHandler_CorCoef:
    MsgBox "Error in module CorrelationCoefficient!", vbOKOnly & vbExclamation, "Attention!"
End Function
Private Function MultiDimensional(CheckArray() As Double) As Boolean


    On Error GoTo ErrHandler_MultiDimensional


    If UBound(CheckArray, 2) > 0 Then
        MultiDimensional = True
    End If


    Exit Function


ErrHandler_MultiDimensional:
    MultiDimensional = False


End Function

The Correlation UDF is from the following site:
HTML:
http://www.freevbcode.com/ShowCode.asp?ID=4543
 
Last edited:

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
You'll have to either create a wrapper function to pass an array of Double types from the range, or change the code to accept MyArray as a simple Variant type.
 
Upvote 0
Untested, but something like this should fix it:

Code:
Public Function CorrelationCoefficient(MyArray, Optional asX As Long = -1, _
                                       Optional asY As Long = -1, Optional asWeight As Long = 0) As Double


    Dim i As Long
    Dim SumX As Double
    Dim SumX2 As Double
    Dim SumY As Double
    Dim SumY2 As Double
    Dim SumXY As Double
    Dim SumW As Double
    Dim weight As Double
    Dim Numerator As Double
    Dim Denominator As Double


    On Error GoTo ErrHandler_CorCoef

    If TypeName(MyArray) = "Range" Then
        MyArray = MyArray.Value
        ReDim outarray(0 To UBound(MyArray) - 1, 0 To UBound(MyArray, 2) - 1) As Double
        Dim x As Long
        For x = 1 To UBound(MyArray)
            Dim y As Long
            For y = 1 To UBound(MyArray, 2)
                outarray(x - 1, y - 1) = MyArray(x, y)
            Next
        Next x
            MyArray = outarray
    End If

    'can correlation coefficient be calculated?
    If MultiDimensional(MyArray) = True And UBound(MyArray, 1) > 1 Then


        'correct weightfactor?
        If asWeight < 0 Then asWeight = 0
        If asWeight > 4 Then asWeight = 0




        'initialise
        SumX = 0
        SumX2 = 0
        SumY = 0
        SumY2 = 0
        SumXY = 0
        SumW = 0


        'determine which columns need to be correlated
        If asX < 0 Then asX = 0
        If asX > UBound(MyArray, 2) Then asX = 0
        If asY < 0 Then asY = 1
        If asY > UBound(MyArray, 2) Then asY = 1


        'calculate SumX, SumX2, SumY, SumY2 and SumXY
        For i = 0 To UBound(MyArray, 1)
            Select Case asWeight
            Case 0    'equal weighting
                weight = 1
            Case 1    '1/x
                If MyArray(i, asX) <> 0 Then
                    weight = Abs(1 / MyArray(i, asX))
                Else
                    weight = 1    'discutable
                End If
            Case 2    '1/x^2
                If (MyArray(i, asX) * MyArray(i, asX)) <> 0 Then
                    weight = Abs(1 / (MyArray(i, asX) * MyArray(i, asX)))
                Else
                    weight = 1    'discutable
                End If
            Case 3    '1/y
                If MyArray(i, asY) <> 0 Then
                    weight = Abs(1 / MyArray(i, asY))
                Else
                    weight = 1    'discutable
                End If
            Case 4    '1/y^2
                If (MyArray(i, asY) * MyArray(i, asY)) <> 0 Then
                    weight = Abs(1 / (MyArray(i, asY) * MyArray(i, asY)))
                Else
                    weight = 1    'discutable
                End If
            End Select
            SumX = SumX + MyArray(i, asX) * weight
            SumX2 = SumX2 + MyArray(i, asX) * MyArray(i, asX) * weight
            SumY = SumY + MyArray(i, asY) * weight
            SumY2 = SumY2 + MyArray(i, asY) * MyArray(i, asY) * weight
            SumXY = SumXY + MyArray(i, asX) * MyArray(i, asY) * weight
            SumW = SumW + weight
        Next i


        Numerator = SumXY - (SumX * SumY / SumW)
        Denominator = Sqr((SumX2 - SumX * SumX / SumW) * (SumY2 - SumY * SumY / SumW))


        If Denominator <> 0 Then
            CorrelationCoefficient = Numerator / Denominator
        Else
            '
        End If


    Else


        CorrelationCoefficient = 99    ' Error value


    End If


    Exit Function




ErrHandler_CorCoef:
    MsgBox "Error in module CorrelationCoefficient!", vbOKOnly & vbExclamation, "Attention!"
End Function
Private Function MultiDimensional(CheckArray) As Boolean


    On Error GoTo ErrHandler_MultiDimensional


    If UBound(CheckArray, 2) > 0 Then
        MultiDimensional = True
    End If


    Exit Function


ErrHandler_MultiDimensional:
    MultiDimensional = False


End Function
 
Upvote 0

Forum statistics

Threads
1,214,427
Messages
6,119,419
Members
448,895
Latest member
omarahmed1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top