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

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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
916
jay11678
J
C
  • Solved
Message box appearing twice when closing workbook
Replies
3
Views
255
Alex Blakenburg
A
S
  • Question
Pop Up Message Box - Out of Date items in a Column
Replies
1
Views
701
GlennUK
G
R
  • Solved
VBA - Message box if specific cell isn't populated
Replies
3
Views
402
Joe4
Joe4
H
  • Solved
message box with option button inside sheet doesn't work
Replies
2
Views
308
Hasson
H

Forum statistics

Threads
1,214,641
Messages
6,120,688
Members
448,978
Latest member
rrauni

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