Сортировка и вывод данных - VB

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

Имеется такая задача: Дана матрица натуральных чисел Y(n,m), в которой столбцы упорядочены по убыванию. Переместить содержимое матрицы в массив S(k) по столбцам и упорядочить по убыванию, удалив одинаковые элементы. Определить новое количество элементов. Я набросал код к ней:

Option Base 1
Sub ShellSort(vArray As Variant)
  Dim TempVal As Variant
  Dim i As Long, GapSize As Long, CurPos As Long
  Dim FirstRow As Long, LastRow As Long, NumRows As Long
  FirstRow = LBound(vArray)
  LastRow = UBound(vArray)
  NumRows = LastRow - FirstRow + 1
   Do
    GapSize = GapSize * 3 + 1
    Loop Until GapSize > NumRows
    Do
      GapSize = GapSize \ 3
      For i = (GapSize + FirstRow) To LastRow
        CurPos = i
       TempVal = vArray(i)
       Do While CompareResult(vArray(CurPos - GapSize), TempVal)
         vArray(CurPos) = vArray(CurPos - GapSize)
         CurPos = CurPos - GapSize
         If (CurPos - GapSize) < FirstRow Then Exit Do
       Loop
       vArray(CurPos) = TempVal
     Next
   Loop Until GapSize = 1
   End Sub
   
Private Function CompareResult(Value1 As Variant, Value2 As Variant)
    CompareResult = (Value1 > Value2)
End Function
Function DelArr(ByRef nArr() As Long, ByVal nIndex As Long)
    If UBound(nArr) = nIndex Then
        ReDim Preserve nArr(nIndex - 1)
    Else
          'Смещаем все элементы
           For i = nIndex To UBound(nArr) - 1
           nArr(i) = nArr(i + 1)
           Next i
            'Подтираем последний
            ReDim Preserve nArr(UBound(nArr) - 1)
        
    End If
End Function
 
Private Sub Command1_Click()
Dim tmp As Long
Dim Y() As Long
Dim S() As Long
Dim i, j, n, M As Long
Dim st As String
n = CLng(Text1)
M = CLng(Text2)
ReDim Y(n, M) As Long
k = M * n
For i = 1 To n
For j = 1 To M
 
Y(i, j) = CLng(InputBox("Строка" & Str(i) & ", столбец" & Str(j), "Ввод массива"))
Next j
Next i
ReDim S(k) As Long
 
For j = 1 To n
For i = 1 To M
S(k) = Y(j, i)
Text3 = Text3 + CStr(S(k)) + " "
Next i
Next j
 
ShellSort (S)
i = 2
Do While i <> UBound(S)
    For j = 1 To i - 1
        If S(i) = S(j) Then
            Call DelArr(S, i)
            i = i - 1
            Exit For
        End If
    Next
    i = i + 1
Loop
Text3 = Text3 + "Начинается: "
 
For i = 1 To UBound(S)
Text3 = Text3 + CStr(S(i)) + " "
Next i
 
End Sub

Все вроде ничего, но вывод после сортирвки не идет. В чем проблема? Заранее благодарю

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

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

                            Private Sub Command1_Click()
Text3 = "Полученный массив: "
Text4 = "Обработанный массив: "
n = Text1 
m = Text2
cnt = n * m
ReDim mas(n, m) As Integer
ReDim S(cnt) As Integer
 
'заполнение массива случайными числами
For i = 0 To n - 1
    For j = 0 To m - 1
        mas(i, j) = Rnd(1) * 10
    Next
Next
 
'Перемещение содержимого матрицы в массив S
k = 0
For i = 0 To n - 1
    For j = 0 To m - 1
        S(k) = mas(i, j)
        Text3 = Text3 & " " & S(k)
        k = k + 1
    Next
Next
 
'Сортировка массива S
For i = 1 To cnt - 1
    j = i
    Do While j > 0
        If S(j) > S(j - 1) Then
            t = S(j)
            S(j) = S(j - 1)
            S(j - 1) = t
            j = j - 1
        Else
            Exit Do
        End If
    Loop
Next
 
'Удаление повторяющихся значений
i = 0
Do While i < cnt
    If S(i) = S(i + 1) Then
        j = i + 1
        cnt = cnt - 1
        Do While j < cnt
            
            S(j) = S(j + 1)
            j = j + 1
        Loop
    Else
        i = i + 1
    End If
Loop
 
'Вывод результата
k = 0
For i = 0 To cnt - 1
        Text4 = Text4 & " " & S(i)
Next
Text4 = Text4 & ", количество элементов " & cnt
End Sub
                        