Сортировка работает некорректно - VB

Формулировка задачи:

Доброго времени суток! Есть сортировка. Она работает идеально только в случае, когда один столбец (в массиве кроме числе больше ничего нет). У меня данные в таком виде: массив dat_ls 01.01.2028 01.01.2017 123 01.02.2014 05.07.2014 456 01.05.2026 07.01.2019 000 Надо отсортировать данные по 1-му или 2-му столбцу так, чтобы данные сохранились (как в EXCEL). А данные сохраняются только в том столбце, который сортируется. Помогите, пожалуйста, как мне видоизменить код, чтобы данные совместно сортировались?

'Запуск сортировки--------------------------------------
 
Dim dt1() As String
 
dt1 = SortArrayMinMaxZnV1(dat_ls, 0, 1, 0)
 
'//Запуск сортировки------------------------------------
 
'Сам код--------------------------------------
 
Public Function SortArrayMinMaxZnV1(ByRef in_arr() As String, ByVal MinMax As LogVar, ByVal NmbStlb As Byte, ByVal SW_Type As Boolean) As String()
 
'SW_Type=1 - сортировка по числам, 0- по дате
 
Dim max_val As Variant
Dim i As Long
Dim x As Long
Dim m As Long

Dim tmp As Variant
Dim tmp1 As String
 
m = 0
x = 0
 
If MinMax = 0 Then 'минимум
 
If SW_Type = 0 Then
 
max_val = CDate("01.01.4099")
 
Else
 
max_val = Val(10000)

End If

Else

If SW_Type = 0 Then
 
max_val = CDate("01.01.1099")
Else
 
max_val = Val(-9999)

End If

End If

M4:
 
For i = m To UBound(in_arr)
 
tmp = ParseStrDIV(Chr(9) & in_arr(i) & Chr(9), Chr(9), Chr(9), NmbStlb - 1)
 
If MinMax = 0 Then 'минимум
 
If SW_Type = 0 Then
 
tmp = CDate(tmp)
Else
 
tmp = Val(tmp)
 
End If

If (tmp < max_val) Then
max_val = tmp
x = i
End If
Else
If (tmp > max_val) Then
max_val = tmp
x = i
End If
End If
 
Next i
 
in_arr(x) = in_arr(m)
 
in_arr(m) = ReplaceCell_InStr(in_arr(m), NmbStlb, CStr(max_val))
 
If MinMax = 0 Then 'минимум
If SW_Type = 0 Then
 
max_val = CDate("01.01.4099")
 
Else
 
max_val = Val(10000)

End If
 
Else
 
If SW_Type = 0 Then
 
max_val = CDate("01.01.1099")
Else
 
max_val = Val(-9999)
 
End If
End If
m = m + 1
If m <= UBound(in_arr) Then GoTo M4
 
SortArrayMinMaxZnV1 = in_arr
 
End Function
 
Public Function ParseStrDIV(ByVal sourc_str As String, ByVal str_div1 As String, ByVal str_div2 As String, ByVal PN As Integer) As String
 
Dim p As Integer
Dim m As Integer
 
PN = PN + 1
 
If str_div1 = vbNullString Then
m = 1
GoTo M4
End If
 
If str_div2 = vbNullString Then
p = Len(sourc_str)
m = CountInSTR(sourc_str, str_div1, PN) + 1
ParseStrDIV = Mid(sourc_str, m, p)
Exit Function
End If
 
m = CountInSTR(sourc_str, str_div1, PN) + 1
 
M4:
 
If m = 1 Then
p = CountInSTR(sourc_str, str_div2, PN) + 1
Else
p = CountInSTR(sourc_str, str_div2, PN + 1) + 1
If m > p Then p = CountInSTR(sourc_str, str_div2, PN - 1) + 1
End If
 
If m = p Then
ParseStrDIV = Mid(sourc_str, m, Len(sourc_str) - m + 1)
Else
 
If Len(str_div1) > 1 And Len(str_div2) > 1 Then
ParseStrDIV = Mid(sourc_str, Len(str_div1) + 1, p - Len(str_div2) - 1)
Else
ParseStrDIV = Mid(sourc_str, m, p - m - 1)
End If
 
End If

End Function
 
Public Function ReplaceCell_InStr(ByVal str_dat As String, ByVal NumbStlb As Byte, ByVal repl_dat As String) As String

Dim i As Long
 
Dim lft_s As String
Dim rgt_s As String
 
Dim sum_s As String
 
'Dim tmp_s As String
 
'Dim len_str As Integer
 
'str_dat = Chr(9) & str_dat & Chr(9)
 
'If NumbStlb = 1 Then NumbStlb = 0
 
'len_str = CountInSTR(str_dat, Chr(9), NumbStlb)
 
lft_s = ParseStrDIV(Chr(9) & str_dat, vbNullString, Chr(9), NumbStlb - 1)

'If NumbStlb = 0 Then NumbStlb = 1
rgt_s = ParseStrDIV(Chr(9) & str_dat & Chr(9), Chr(9), vbNullString, NumbStlb)
 
sum_s = Replace(lft_s & Chr(9) & repl_dat & Chr(9) & rgt_s, Chr(9) & Chr(9), Chr(9))
 
'if
 
'If ParseStrDIV(sum_s, Chr(9), vbNullString, 0) = Chr(9) Then sum_s = Left(sum_s, Len(sum_s) - 1)
'If ParseStrDIV(sum_s, vbNullString, Chr(9), 0) = Chr(9) Then sum_s = Right(sum_s, Len(sum_s) - 1)
 
ReplaceCell_InStr = sum_s 'Replace(lft_s & Chr(9) & repl_dat & Chr(9) & rgt_s, Chr(9) & Chr(9), Chr(9))
 
End Function
 
Public Function CountInSTR(ByVal str As String, ByVal find_str As String, Optional ByVal p_numb As Long = 0) As Long
 
Dim x As Long
Dim cnt_count As Long
Dim tmp_temp As Long
 
'x = InStr(1, str, find_str)
 
' p_numb - ДЈД«Д™Д·Д« ГіЕєД…Д“Д…Е†Гј Д·Д«ДЈГҐЕЎ ЕјД—ГҐДЈГҐД·Е†Д… ДјД« Е„Г·ГёЕ†Гі ДЃ Е„Е†ЕЎД«ЕєГҐ, Г·Е†Д«ДЇЕ« ДјД«Д—ГіГ·ДЌЕ†Гј Г¤Д—ДЌД·Гі Г¤Д« Д·ГҐД‡Д«
 
'Dim y As Long
 
If p_numb = 0 Then p_numb = Len(str)

For x = 1 To p_numb 'Len(str)
 
cnt_count = InStr(cnt_count + 1, str, find_str)
If cnt_count = 0 Then Exit For
tmp_temp = cnt_count
'y = y + 1
Next x
 
CountInSTR = tmp_temp
 
End Function
 
'//Сам код------------------------------------

Решение задачи: «Сортировка работает некорректно»

textual
                            Листинг программы 
                        

                            Sub Sort_(Arr() As String, nCol As Integer)
 
    s% = LBound(Arr, 1)
    e% = UBound(Arr, 1)
    
    For i% = s% To e% - 1
        For j% = i% + 1 To e%
            If CDate(Arr(i%, nCol%)) > CDate(Arr(j%, nCol%)) Then
               For k% = LBound(Arr, 2) To UBound(Arr, 2)
                   tmp$ = Arr(i%, k%)
                   Arr(i%, k%) = Arr(j%, k%)
                   Arr(j%, k%) = tmp$
               Next k%
            End If
        Next j%
    Next i%
 
End Sub
 
Sub Test()
 
Dim X(1 To 3, 1 To 3) As String
 
    X(1, 1) = "01.01.2028"
    X(1, 2) = "01.01.2017"
    X(1, 3) = "123"
    X(2, 1) = "01.02.2014"
    X(2, 2) = "05.07.2014"
    X(2, 3) = "456"
    X(3, 1) = "01.05.2026"
    X(3, 2) = "07.01.2019"
    X(3, 3) = "000"
 
    Debug.Print "Сортировка по 1-й колонке"
    Debug.Print
 
    Sort_ X, 1
 
    For i% = 1 To 3
        For j% = 1 To 3
            Debug.Print X(i%, j%); " ";
        Next j%
        Debug.Print
    Next i%
 
    Debug.Print
    Debug.Print "Сортировка по 2-й колонке"
    Debug.Print
    
    Sort_ X, 2
 
    For i% = 1 To 3
        For j% = 1 To 3
            Debug.Print X(i%, j%); " ";
        Next j%
        Debug.Print
    Next i%
 
    Debug.Print
    
End Sub
                        