Matrix Inverse message box help

A

Arcadian Myth

New Member
Joined
Apr 1, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello all,

I'm new to this forum, but I feel like this is a great place to get help. I am trying to find the correct If Then coding to use that will pop up a message box if there is no inverse to a matrix, but everything I have tried has failed. The closest I have gotten to something that works is the following:

If Solution = True Then
Selection.Copy
Sheets("Solution").Select
Sheets("Solution").Range("B5").Resize(rowsize:=nRowA, columnsize:=nColA).Select
Selection.FormulaArray = "=MINVERSE(Amat)"
Selection.Font.Bold = True
Application.CutCopyMode = False
Else
strMessage = "Matrix does not have an Inverse"
MsgBox strMessage
Sheets("Solution").Select
Selection.ClearContents
End If

But this prompts the message box whether there is an answer or not. I spent a few hours on google trying to find a solution, and that's how I got here. Please help me understand how to do this. I was thinking using the fact that an inverse that does not exist gives a calculation error of #NUM! and somehow integrating that into the If Then statement, but I don't know the commands, or how to even start that. Please help.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
A previous post in this forum had this suggestion. I have not tested it. on very large matrices

Code: 
Sub GaussJordan()

    Dim a As Variant, c#(), x#, y#
    Dim m&, u#, i&, j&, rv&()
    Dim q&, w&


    Set a = Cells(1).CurrentRegion
    m = a.Rows.Count 'UBound(a, 1)
    ReDim c(1 To m, 1 To m), rv(1 To m, 1 To 2)
    For i = 1 To m: c(i, i) = 1: Next i
        For q = 1 To m
            u = 10 ^ 15
            For i = 1 To m
                If rv(i, 1) = 0 Then
                    If a(i, q) <> 0 Then
                        If (Log(a(i, q) ^ 2)) ^ 2 < u Then
                            u = (Log(a(i, q) ^ 2)) ^ 2
                            w = i
                        End If
                    End If
                End If
            Next i


            rv(w, 1) = w: rv(q, 2) = w: x = a(w, q)
            For j = 1 To m
                a(w, j) = a(w, j) / x
                c(w, j) = c(w, j) / x
            Next j
            For i = 1 To m
                If rv(i, 1) = 0 Then
                    y = a(i, q)
                    For j = 1 To m
                        a(i, j) = a(i, j) - y * a(w, j)
                        c(i, j) = c(i, j) - y * c(w, j)
                    Next j
                End If
            Next i, q
            
 'BACK SOLUTION
            For q = m To 2 Step -1: For w = q - 1 To 1 Step -1
                x = a(rv(w, 2), q)
                a(rv(w, 2), q) = a(rv(w, 2), q) - x * a(rv(q, 2), q)
                For j = 1 To m
                    c(rv(w, 2), j) = c(rv(w, 2), j) - x * c(rv(q, 2), j)
                Next j
            Next w, q
            For q = 1 To m: For j = 1 To m
                a(q, j) = c(rv(q, 2), j)
            Next j, q
            Cells(m + 2, 1).Resize(m, m) = a


        End Sub
 
Upvote 0
BTW: you an use MDETERM(array) to find out if there is a non-zero determinant or, if 0, there is no inverse.
Place that in the beginning of your code and handle accordingly.
 
Upvote 0
kweaver said:
A previous post in this forum had this suggestion. I have not tested it. on very large matrices

Code: 
Sub GaussJordan()

    Dim a As Variant, c#(), x#, y#
    Dim m&, u#, i&, j&, rv&()
    Dim q&, w&


    Set a = Cells(1).CurrentRegion
    m = a.Rows.Count 'UBound(a, 1)
    ReDim c(1 To m, 1 To m), rv(1 To m, 1 To 2)
    For i = 1 To m: c(i, i) = 1: Next i
        For q = 1 To m
            u = 10 ^ 15
            For i = 1 To m
                If rv(i, 1) = 0 Then
                    If a(i, q) <> 0 Then
                        If (Log(a(i, q) ^ 2)) ^ 2 < u Then
                            u = (Log(a(i, q) ^ 2)) ^ 2
                            w = i
                        End If
                    End If
                End If
            Next i


            rv(w, 1) = w: rv(q, 2) = w: x = a(w, q)
            For j = 1 To m
                a(w, j) = a(w, j) / x
                c(w, j) = c(w, j) / x
            Next j
            For i = 1 To m
                If rv(i, 1) = 0 Then
                    y = a(i, q)
                    For j = 1 To m
                        a(i, j) = a(i, j) - y * a(w, j)
                        c(i, j) = c(i, j) - y * c(w, j)
                    Next j
                End If
            Next i, q
           
 'BACK SOLUTION
            For q = m To 2 Step -1: For w = q - 1 To 1 Step -1
                x = a(rv(w, 2), q)
                a(rv(w, 2), q) = a(rv(w, 2), q) - x * a(rv(q, 2), q)
                For j = 1 To m
                    c(rv(w, 2), j) = c(rv(w, 2), j) - x * c(rv(q, 2), j)
                Next j
            Next w, q
            For q = 1 To m: For j = 1 To m
                a(q, j) = c(rv(q, 2), j)
            Next j, q
            Cells(m + 2, 1).Resize(m, m) = a


        End Sub
Click to expand...
I'm trying to build off the code I was given. The red text is the code that does not work. This is the code I'm using for the inverse matirx:

Sub A_Inverse()
'
' A_Inverse Macro
'
Sheets("Solution").Select
Sheets("Solution").Range("B5").Select
Selection.CurrentRegion.Select
Selection.ClearContents
Sheets("Matrix A").Select
Sheets("Matrix A").Range("B5").Select
Selection.CurrentRegion.Select
Selection.Name = "Amat"
nRowA = Sheets("Matrix A").Range("Amat").Rows.Count
nColA = Sheets("Matrix A").Range("Amat").Columns.Count
If Solution = True Then
Selection.Copy
Sheets("Solution").Select
Sheets("Solution").Range("B5").Resize(rowsize:=nRowA, columnsize:=nColA).Select
Selection.FormulaArray = "=MINVERSE(Amat)"
Selection.Font.Bold = True
Application.CutCopyMode = False
Else
strMessage = "Matrix does not have an Inverse"
MsgBox strMessage
Sheets("Solution").Select
Selection.ClearContents
End If

'
End Sub

And I'm trying to keep it clean looking:

1649040415339.png
 
Upvote 0
With the matrix initiating in A1, try this:

Code: 
Sub GaussJordan()

    Dim a As Variant, c#(), x#, y#
    Dim m&, u#, i&, j&, rv&()
    Dim q&, w&


    Set a = Cells(1).CurrentRegion
    
[COLOR=rgb(184, 49, 47)]    If 0 = Application.WorksheetFunction.MDeterm(Cells(1).CurrentRegion) Then
     MsgBox "No Inverse"
     Exit Sub
     Else
    End If[/COLOR]
    
    m = a.Rows.Count 'UBound(a, 1)
    ReDim c(1 To m, 1 To m), rv(1 To m, 1 To 2)
    For i = 1 To m: c(i, i) = 1: Next i
        For q = 1 To m
            u = 10 ^ 15
            For i = 1 To m
                If rv(i, 1) = 0 Then
                    If a(i, q) <> 0 Then
                        If (Log(a(i, q) ^ 2)) ^ 2 < u Then
                            u = (Log(a(i, q) ^ 2)) ^ 2
                            w = i
                        End If
                    End If
                End If
            Next i


            rv(w, 1) = w: rv(q, 2) = w: x = a(w, q)
            For j = 1 To m
                a(w, j) = a(w, j) / x
                c(w, j) = c(w, j) / x
            Next j
            For i = 1 To m
                If rv(i, 1) = 0 Then
                    y = a(i, q)
                    For j = 1 To m
                        a(i, j) = a(i, j) - y * a(w, j)
                        c(i, j) = c(i, j) - y * c(w, j)
                    Next j
                End If
            Next i, q
            
 'BACK SOLUTION
            For q = m To 2 Step -1: For w = q - 1 To 1 Step -1
                x = a(rv(w, 2), q)
                a(rv(w, 2), q) = a(rv(w, 2), q) - x * a(rv(q, 2), q)
                For j = 1 To m
                    c(rv(w, 2), j) = c(rv(w, 2), j) - x * c(rv(q, 2), j)
                Next j
            Next w, q
            For q = 1 To m: For j = 1 To m
                a(q, j) = c(rv(q, 2), j)
            Next j, q
            Cells(m + 2, 1).Resize(m, m) = a


        End Sub [code]
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA for inverse matrix
Replies
8
Views
1K
jay11678
J
M
  • Solved
Show message box on userform after sum or subtraction
Replies
2
Views
111
Maklil
M
Rob_010101
  • Solved
Add message box
Replies
4
Views
503
Joe4
Joe4
C
  • Solved
Message box appearing twice when closing workbook
Replies
3
Views
496
Alex Blakenburg
A
T
  • Question Question
HELP, PLEASE?!
2
Replies
12
Views
403
Anthony47
A

Forum statistics

Threads
1,224,816
Messages
6,181,143
Members
453,021
Latest member
Justyna P

Share this page

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