Avatar of Michael Hamacher
Michael Hamacher
 asked on

VBA code - debugging


I have the VBA code below to determine the eigenvectors and values of a pos semidefinite matrix. However, it returns an error of type mismatch if I use it...I was wondering whether anyone may be able to advise what the issue may be


Function EIGEN_JK(ByRef M As Variant) As Variant

Dim A() As Variant, Ematrix() As Double
Dim i As Long, j As Long, k As Long, iter As Long, p As Long
Dim den As Double, hold As Double, Sin_ As Double, num As Double
Dim Sin2 As Double, Cos2 As Double, Cos_ As Double, Test As Double
Dim Tan2 As Double, Cot2 As Double, tmp As Double
Const eps As Double = 1E-16
    On Error GoTo EndProc
    A = M
    p = UBound(A, 1)
    ReDim Ematrix(1 To p, 1 To p + 1)
    For iter = 1 To 15
        'Orthogonalize pairs of columns in upper off diag
        For j = 1 To p - 1
            For k = j + 1 To p
                den = 0#
                num = 0#
                'Perform single plane rotation
                For i = 1 To p
                    num = num + 2 * A(i, j) * A(i, k)   ': numerator eq. 11
                    den = den + (A(i, j) + A(i, k)) * _
                        (A(i, j) - A(i, k))             ': denominator eq. 11
                Next i
                'Skip rotation if aij is zero and correct ordering
                If Abs(num) < eps And den >= 0 Then Exit For
                'Perform Rotation
                If Abs(num) <= Abs(den) Then
                    Tan2 = Abs(num) / Abs(den)          ': eq. 11
                    Cos2 = 1 / Sqr(1 + Tan2 * Tan2)     ': eq. 12
                    Sin2 = Tan2 * Cos2                  ': eq. 13
                    Cot2 = Abs(den) / Abs(num)          ': eq. 16
                    Sin2 = 1 / Sqr(1 + Cot2 * Cot2)     ': eq. 17
                    Cos2 = Cot2 * Sin2                  ': eq. 18
                End If
                Cos_ = Sqr((1 + Cos2) / 2)              ': eq. 14/19
                Sin_ = Sin2 / (2 * Cos_)                ': eq. 15/20
                If den < 0 Then
                    tmp = Cos_
                    Cos_ = Sin_                         ': table 21
                    Sin_ = tmp
                End If
                Sin_ = Sgn(num) * Sin_                  ': sign table 21
                For i = 1 To p
                    tmp = A(i, j)
                    A(i, j) = tmp * Cos_ + A(i, k) * Sin_
                    A(i, k) = -tmp * Sin_ + A(i, k) * Cos_
                Next i
            Next k
        Next j
        'Test for convergence
        Test = Application.SumSq(A)
        If Abs(Test - hold) < eps And iter > 5 Then Exit For
        hold = Test
    Next iter
    If iter = 16 Then MsgBox "JK Iteration has not converged."
    'Compute eigenvalues/eigenvectors
    For j = 1 To p
        'Compute eigenvalues
        For k = 1 To p
            Ematrix(j, 1) = Ematrix(j, 1) + A(k, j) ^ 2
        Next k
        Ematrix(j, 1) = Sqr(Ematrix(j, 1))
        'Normalize eigenvectors
        For i = 1 To p
            If Ematrix(j, 1) <= 0 Then
                Ematrix(i, j + 1) = 0
                Ematrix(i, j + 1) = A(i, j) / Ematrix(j, 1)
            End If
        Next i
    Next j
    EIGEN_JK = Ematrix
    Exit Function
    MsgBox prompt:="Error in function EIGEN_JK!" & vbCr & vbCr & _
        "Error: " & Err.Description & ".", Buttons:=48, _
        Title:="Run time error!"
End Function
Visual Basic ClassicMicrosoft Excel

Avatar of undefined
Last Comment

8/22/2022 - Mon
Martin Liss

If you are interested please see my article on debugging.

Where in the code do you get the error?
Michael Hamacher

Thanks. I tried the basic debugging but am unable to locate the error in this case...
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Martin Liss

If you set a breakpoint and then use F8 to step through the code you should find the line that is causing the problem. You could also add line numbers and then the "erl" property will return the problem line number.
Michael Hamacher

I am not quite sure how to debug a code that's a function (instead of a sub).

If I call the function in a sub as per below (where C3:D4 contains a simple matrix) the code runs smoothly. Only when tyring to call it from excel, i.e. within the spreadsheet, the error of type mismatch occurs...not sure what to make out of it

Sub Test()

Dim Arr() As Variant
Arr = Range("C3:D4")


End Sub
Michael Hamacher

Just as an fyi: I added the line

Debug.Print EIGEN_JK(Arr)

to the sub above, and it throws the same error of type mismatch....
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.

So when you have a formula like this in a cell you get the type mismatch?

Michael Hamacher

yes indeed

I have no problems with the function when I enter that as a formula.

How are you entering it?

Since the function returns an array it should be array entered.

For example you would select G2:H3, enter the formula and then commit with CTRL+SHIFT+ENTER.

When I do that with a simple set of data i C3:D4 I get no errors.
Your help has saved me hundreds of hours of internet surfing.
Michael Hamacher

hmmm....that's exactly what I am doing and it doesn't work for me...pls see attached screenshort + sample spreadsheet for your reference

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Michael Hamacher

Thanks. Indeed that seems to have done the trick...in the meantime: in order to avoid the M.Value part - can I pass M in a different format (instead of range)?


What other format would you pass it in?
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.