Linear system solving ( N*N matrix multiplication ), VBA - excel

Question

I have 2 arrays. Array1 is n * n and Array2 is 1 * n.
These arrays are given in worksheets. In this case Sheet3 and Sheet4 and I need to output the answer on Sheet5.
I get multiple errors like "Subscript out of range".
I can't seem to figure out why this isn't working:
Public Sub LinearSystemSolver()
x = Sheet3.UsedRange.Rows.Count
y = Sheet3.UsedRange.Columns.Count
Z = Sheet4.UsedRange.Rows.Count
Dim a As Variant
ReDim a(1 To x, 1 To y)
Dim b As Variant
ReDim b(1 To Z, 1 To 1)
Dim g As Variant
ReDim g(1 To Z, 1 To 1)
For i = 1 To x
For j = 1 To y
a(i, j) = Sheet3.Cells(i, j)
Next
Next
For f = 1 To Z
b(f,1) = Sheet4.Cells(f,1)
Next
g = Application.WorksheetFunction.MMult((Application.WorksheetFunction.MInverse(a)), b)
For h = 1 To Z
Sheet5.Cells(h, 1) = g(h, 1)
Next
End Sub

Answer 1

You can speed up your code by assigning to the arrays directly and avoid loops
a = Sheet3.Range("A1").Resize(x,y).Value
b = Sheet4.Range("A1").Resize(z,1).Value
...
Sheet5.Range("A1").Resize(z,1).Value = g
Now as far as inverting the matrix (if x=y=z) the I propose to use LU decomposition. I have attached a working example which I have used for many years.
The driver code is
Private Sub solveButton_Click()
Dim lu As New LuSolver
' Get Matrix values and decompose them into L, U, P form
' Values are in B3 and matrix is a 5×5 size
lu.IntializeFromRange Range("B3"), 5
' Solve the A*x=b matrix system for x
' right hand side is in J3 and it is a 5×1 size
' resulting 5×1 matrix will be placed under H3
lu.Solve Range("J3"), 1, Range("H3")
End Sub
with the LU solver in a class called 'LuSolver"
'---------------------------------------------------------------------------------------
' Module : LuSolver
' DateTime : 6/30/2008 13:01
' Author : ja72
' Purpose : LU Decomposition of rectangular matrix.
' Remarks:
'For an n-by-n matrix A, the LU decomposition is an n-by-n
'unit lower triangular matrix L, an n-by-n upper triangular matrix U,
'and a permutation vector piv of length n so that A(piv)=L*U.
'---------------------------------------------------------------------------------------
Option Explicit
Private lu As Variant
Private sign As Integer
Private pivot() As Integer
Private size As Integer
Private Sub Class_Initialize()
Set lu = Nothing
Erase pivot
sign = 1
End Sub
Private Sub Class_Terminate()
Set lu = Nothing
Erase pivot
sign = 0
End Sub
Public Sub IntializeFromRange(ByRef r_coef As Range, ByVal matrix_size As Integer)
Dim k_max As Integer, k As Integer, p As Integer
Dim i As Integer, j As Integer
Dim s As Variant
On Error GoTo IntializeFromRange_Error
lu = r_coef.Resize(matrix_size, matrix_size).Value
size = matrix_size
'Set pivot as a sequence of integers
ReDim pivot(1 To size)
For i = 1 To size
pivot(i) = i
Next i
sign = 1
For j = 1 To size
'Apply previous transformations
For i = 1 To size
If j > i Then k_max = i Else k_max = j
s = 0
'Time consuming dot product
For k = 1 To k_max - 1
s = s + lu(i, k) * lu(k, j)
Next k
lu(i, j) = lu(i, j) - s
Next i
'Find the pivot element
p = j
For i = j + 1 To size
If Abs(lu(i, j)) > Abs(lu(p, j)) Then
p = i
End If
Next i
'Exchange pivot rows
If p <> j Then
For k = 1 To size
s = lu(p, k)
lu(p, k) = lu(j, k)
lu(j, k) = s
Next k
k = pivot(p)
pivot(p) = pivot(j)
pivot(j) = k
sign = -sign
End If
'Compute Multipliers
s = lu(j, j)
If j <= size And s <> 0 And s <> 1 Then
For i = j + 1 To size
lu(i, j) = lu(i, j) / s
Next i
End If
Next j
On Error GoTo 0
Exit Sub
IntializeFromRange_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IntializeFromRange of Class Module LuDecomposition"
End Sub
Public Property Get IsSingular() As Boolean
IsSingular = Not IsNonSingular
End Property
Public Property Get IsNonSingular() As Boolean
IsNonSingular = True
Dim j As Integer
For j = 1 To size
If lu(j, j) = 0 Then
IsNonSingular = False
Exit Property
End If
Next j
End Property
Public Sub Solve(ByRef r_rhs As Range, ByVal no_of_columns, ByRef r_result As Range)
On Error GoTo Solve_Error
Dim rhs As Variant
Dim N As Integer, M As Integer, r As Integer
Dim i As Integer, j As Integer, k As Integer
N = size
M = size
r = no_of_columns
rhs = r_rhs.Resize(size, r).Value
'Copy rhs with pivoting
Dim X As Variant
ReDim X(1 To size, 1 To r)
For i = 1 To size
For j = 1 To r
X(i, j) = rhs(pivot(i), j)
Next j
Next i
'Solve L*Y = B
For k = 1 To M
For i = k + 1 To M
For j = 1 To r
X(i, j) = X(i, j) - X(k, j) * lu(i, k)
Next j
Next i
Next k
'Solve U*X=Y
For k = M To 1 Step -1
For j = 1 To r
X(k, j) = X(k, j) / lu(k, k)
Next j
For i = 1 To k - 1
For j = 1 To r
X(i, j) = X(i, j) - X(k, j) * lu(i, k)
Next j
Next i
Next k
r_result.Resize(size, no_of_columns).Value = X
On Error GoTo 0
Exit Sub
Solve_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Solve of Class Module LuDecomposition"
End Sub

Answer 2

In the following, loop Cells() needs two arguments:
For f = 1 To Z
b(f) = Sheet4.Cells(f)
Next
There may be other problems.