Why is my VBA Code for the RREF of a matrix in Excel not working?

Question

Function ReduceToRREF(matrixRange As Range) As Variant
    Dim matrix As Variant
    Dim rowCount As Long
    Dim colCount As Long
    Dim lead As Long
    Dim r As Long
    Dim c As Long
    Dim i As Long
    Dim multiplier As Double

    matrix = matrixRange.Value
    rowCount = UBound(matrix, 1)
    colCount = UBound(matrix, 2)
    lead = 1
    

    For r = 1 To rowCount
        If colCount < lead Then Exit For
        i = r
        While matrix(i, lead) = 0
            i = i + 1
            If rowCount < i Then
                i = r
                lead = lead + 1
                If colCount < lead Then Exit For
            End If
        Wend
        If i <> r Then
            For c = lead To colCount
                matrix(r, c) = matrix(r, c) + matrix(i, c)
            Next c
        End If
        multiplier = matrix(r, lead)
        For c = lead To colCount
            matrix(r, c) = matrix(r, c) / multiplier
        Next c
        For i = 1 To rowCount
            If i <> r Then
                multiplier = matrix(i, lead)
                For c = lead To colCount
                    matrix(i, c) = matrix(i, c) - multiplier * matrix(r, c)
                Next c
            End If
        Next i
        lead = lead + 1
    Next r

    ReduceToRREF = matrix
End Function

I thought this was a great solution, and it does seem to work properly in most cases. However, I've run into an example where it fails:

This:

Returns this:

When it should return this:

Any ideas on what might be going wrong?

I also tried taking the RREF of just the first three rows of the matrix, and that works as expected. What's going on?

Answer 1

Reduced Row Echelon Form

Links

• I found this PDF explaining what it is, I guess as simply as possible.
• Here is what Wikipedia thinks about it.

About

• You were right on both accounts: your function is producing the wrong result and you have presented the correct result.
• Unfortunately, I've never heard of it but I studied it for a while and figured out how it works (manually).
• I have no idea if your function is correct or enough knowledge to figure out what's wrong with it yet.
• I simply sorted the data, which is allowed, and got the correct result. Hence I wrote a procedure so you could sort the matrix right after you have obtained it from the range.
• The procedure uses a bubble sort algorithm (the easiest but slowest) which sorts the data ascending from top to bottom and 'left to right' the latter meaning if the values are equal in the first column, the smaller value in the next column(s) will determine the top-most of the two.
• BTW, the correct result was also obtained with the data sorted descending.
• It's up to you to test it hence your feedback is appreciated.

The Fix!?

• In your function, right below the line

  matrix = matrixRange.Value
  

  add the line

  SortData matrix
  

  which uses the following procedure.

The Sort Procedure

Sub SortData(ByRef Data As Variant)
    
    Dim LB1 As Long, UB1 As Long: LB1 = LBound(Data, 1): UB1 = UBound(Data, 1)
    Dim LB2 As Long, UB2 As Long: LB2 = LBound(Data, 2): UB2 = UBound(Data, 2)
    
    Dim pVal, nVal, tVal, i As Long, j As Long, c As Long, IsSwappy As Boolean
    
    For i = LB1 To UB1 - 1
        For j = i + 1 To UB1
            pVal = Data(i, LB2)
            nVal = Data(j, LB2)
            Select Case pVal
                Case nVal
                    For c = LB2 + 1 To UB2
                        Select Case Data(i, c)
                            Case Is > Data(j, c): IsSwappy = True: Exit For
                            Case Is < Data(j, c): Exit For
                        End Select
                    Next c
                Case Is > nVal: IsSwappy = True
            End Select
            If IsSwappy Then
                For c = LB2 To UB2
                    tVal = Data(i, c)
                    Data(i, c) = Data(j, c)
                    Data(j, c) = tVal
                Next c
                IsSwappy = False
            End If
        Next j
    Next i
            
End Sub

A Test For the Sort Procedure

Sub SortDataTEST()
    Dim Data(): Data = Sheet1.Range("A1").CurrentRegion
    PrintData Data, , , "Initial"
    SortData Data
    PrintData Data, , , "Sorted"
End Sub

• To not clutter SO with existing code, copy the PrintData procedure from here.

My Test Procedure

Sub ReduceToRREFtest()

    Dim Data()

    With Sheet1.Range("A1").CurrentRegion
        Data = ReduceToRREF(.Cells)
    End With
    
    With Sheet2.Range("A1").Resize(UBound(Data, 1), UBound(Data, 2))
        .Value = Data
    End With

End Sub

• Note that the -5 was changed manually from 4.999999 and something and so were two bottom-row zeros from 0.000000 and something. Obviously, you somehow need to cover for the decimal issues occurring.