Solved

VBA code - debugging

Posted on 2014-11-10
13
276 Views
Last Modified: 2014-11-10
Hello,

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

cheers


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
                Else
                    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
               
                'Rotate
                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
            Else
                Ematrix(i, j + 1) = A(i, j) / Ematrix(j, 1)
            End If
        Next i
    Next j
       
    EIGEN_JK = Ematrix
   
    Exit Function
   
EndProc:
    MsgBox prompt:="Error in function EIGEN_JK!" & vbCr & vbCr & _
        "Error: " & Err.Description & ".", Buttons:=48, _
        Title:="Run time error!"
End Function
0
Comment
Question by:Michael Hamacher
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 5
  • 2
13 Comments
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40434150
If you are interested please see my article on debugging.
0
 
LVL 34

Expert Comment

by:Norie
ID: 40434151
Where in the code do you get the error?
0
 

Author Comment

by:Michael Hamacher
ID: 40434152
Thanks. I tried the basic debugging but am unable to locate the error in this case...
0
Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

 
LVL 48

Expert Comment

by:Martin Liss
ID: 40434160
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.
0
 

Author Comment

by:Michael Hamacher
ID: 40434166
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")

EIGEN_JK (Arr)

End Sub
0
 

Author Comment

by:Michael Hamacher
ID: 40434176
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....
0
 
LVL 34

Expert Comment

by:Norie
ID: 40434177
So when you have a formula like this in a cell you get the type mismatch?

=EIGEN_JK(C3:D4)
0
 

Author Comment

by:Michael Hamacher
ID: 40434182
yes indeed
0
 
LVL 34

Expert Comment

by:Norie
ID: 40434194
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.
0
 

Author Comment

by:Michael Hamacher
ID: 40434215
hmmm....that's exactly what I am doing and it doesn't work for me...pls see attached screenshort + sample spreadsheet for your reference
Eigen-JK.bmp
Sample.xlsm
0
 
LVL 34

Accepted Solution

by:
Norie earned 500 total points
ID: 40434226
Since you are passing a range, C3:D4, to the function try changing this.
  A = M

Open in new window


to this.
A=M.Value

Open in new window


Or change this,
Function EIGEN_JK(ByRef M As Variant) As Variant

Open in new window

to this.
Function EIGEN_JK(ByRef M As Range) As Variant

Open in new window

0
 

Author Comment

by:Michael Hamacher
ID: 40434235
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)?

Cheers
0
 
LVL 34

Expert Comment

by:Norie
ID: 40434257
What other format would you pass it in?
0

Featured Post

Enroll in June's Course of the Month

June's Course of the Month is now available! Every 10 seconds, a consumer gets hit with ransomware. Refresh your knowledge of ransomware best practices by enrolling in this month's complimentary course for Premium Members, Team Accounts, and Qualified Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

717 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question