VBA Gauss-Jordan implementation

VBA has no implementation for array inversion, neither equations solver. So it comes very handy a Gauss-Jordan solver:

Public Function fGaussJordan(ByRef mArray() As Double) As Double()
Dim lgR As Long
Dim lgC As Long
Dim lgPivot As Long
Dim lgR_Homogenize As Long
Dim dbTmp As Double
Dim lgRetVal As Long
Dim mArrayTmp() As Double
Dim Nm As Integer

On Error GoTo ErrControl

Nm = UBound(mArray, 1) - LBound(mArray, 1) + 1
ReDim mArrayTmp(LBound(mArray, 1) To UBound(mArray, 1), LBound(mArray, 2) To UBound(mArray, 2))

' Swap rows (if needed)
If (mArray(0, 0) = 0) Then
For lgR = LBound(mArray, 1) To UBound(mArray, 1)
If (mArray(lgR, 0) 0) Then
For lgC = LBound(mArray, 2) To UBound(mArray, 2)
mArrayTmp(0, lgC) = mArray(0, lgC)
mArray(0, lgC) = mArray(lgR, lgC)
mArray(lgR, lgC) = mArrayTmp(0, lgC)
Next lgC
End If
Next lgR
End If

For lgPivot = LBound(mArray, 1) To UBound(mArray, 1)
dbTmp = mArray(lgPivot, lgPivot)
For lgC = LBound(mArray, 2) To UBound(mArray, 2)
mArray(lgPivot, lgC) = mArray(lgPivot, lgC) / dbTmp
Next lgC
For lgR = LBound(mArray, 1) To UBound(mArray, 1)
If (lgR = lgPivot) Then GoTo NextRow
dbTmp = mArray(lgR, lgPivot)
For lgR_Homogenize = LBound(mArray, 2) To UBound(mArray, 2)
mArray(lgR, lgR_Homogenize) = mArray(lgR, lgR_Homogenize) - (dbTmp * mArray(lgPivot, lgR_Homogenize))
Next lgR_Homogenize
NextRow:
Next lgR
Next lgPivot

'Print solution
ReDim mArrayTmp(LBound(mArray, 1) To UBound(mArray, 1))
For lgR = LBound(mArray, 1) To UBound(mArray, 1)
mArrayTmp(lgR) = mArray(lgR, Nm)
'Debug.Print VBA.Format(mArray(lgR, Nm), "##,##0.00")
Next lgR
fGaussJordan = mArrayTmp()

ExitProc:
Exit Function

ErrControl:
lgRetVal = VBA.MsgBox("System has no solution", vbCritical)
End Function
[/sourcecode]

2 thoughts on “VBA Gauss-Jordan implementation”

    1. Yes, it’s a problem with the WP code parser. There should be an “=” operator in between (at least that’s how it looks on my VBA code :)).

Leave a Reply

Your email address will not be published. Required fields are marked *