Поменять строки матрицы по условию

Option Explicit
 
Sub test()
    Dim A(5, 5) As Double, s1 As String, s2 As String
    Dim i As Long, j As Long, t As Double
    Dim minVal As Double, minRow As Long
    Dim maxVal As Double, maxRow As Long
    
    ' Заполнение матрицы вручную через InputBox
    s1 = ""
    For i = LBound(A, 1) To UBound(A, 1)
        For j = LBound(A, 2) To UBound(A, 2)
            A(i, j) = InputBox("A(", i, ",", j, ") = ")
            s1 = s1 & A(i, j) & vbTav
        Next
        s1 = s1 & vbCrLf
    Next
    MsgBox s1 ' Вывести исходную матрицу
    
    ' Поиск максимального и минимального элементов
    minVal = A(LBound(A, 1), LBound(A, 2))
    minRow = LBound(A, 1)
    maxVal = minVal
    maxRow = minRow
    For i = LBound(A, 1) To UBound(A, 1)
        For j = LBound(A, 2) To UBound(A, 2)
            If minVal > A(i, j) Then
                minVal = A(i, j)
                minRow = i
            End If
            If maxVal < A(i, j) Then
                maxVal = A(i, j)
                maxRow = i
            End If
        Next
    Next
    
    ' Поменять строки с max и min местами
    For i = LBound(A, 2) To UBound(A, 2)
        t = A(i, minRow)
        A(i, minRow) = A(i, maxRow)
        A(i, maxRow) = t
    Next
    
    s2 = ""
    For i = LBound(A, 1) To UBound(A, 1)
        For j = LBound(A, 2) To UBound(A, 2)
            s2 = s2 & A(i, j) & vbTav
        Next
        s2 = s2 & vbCrLf
    Next
    MsgBox s2 ' Вывести конечную матрицу
End Sub