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 *