Нужно сжать массив, удалив отрицательные элементы

For i = 1 To n
If A(i) < 0 Then A(i) = " "
Text5.Text = Text5.Text + "  " + Str(A(i))
Next i

Sub ShrinkNegative()
Dim A(), x, y, A1()
A = Array(Rnd - 0.5, Rnd - 0.5, Rnd - 0.5, Rnd - 0.5, Rnd - 0.5, Rnd - 0.5)
Debug.Print "Массив до"
For Each x In A: Debug.Print x: Next
A1 = A
y = LBound(A)
For Each x In A
    If x >= 0 Then A1(y) = x: y = y + 1
Next
If y > LBound(A) Then
    ReDim Preserve A1(LBound(A1) To y - 1)
    A = A1
    Debug.Print "Массив после"
    For Each x In A: Debug.Print x: Next
Else
    Debug.Print "Все элементы отрицательные!"
End If
Erase A1
End Sub

Private Sub Command1_Click()
n = 10
ReDim a(n)
Cls
k = 0
For i = 1 To n
  a(i) = Int(Rnd * 11) - 5
    Print a(i); vbTab;
      If a(i) >= 0 Then k = k + 1
Next i
Print
 If k = 0 Then
 Print "{0}"
 Else
 For i = 1 To k
   Do While a(i) < 0
   t = a(i)
     For j = i + 1 To n
          a(j - 1) = a(j)
     Next j
   a(n) = t
   Loop
  'Print a(i); vbTab;
 Next i
 
 ReDim Preserve a(k)
For i = 1 To UBound(a)
  Print a(i); vbTab;
Next i
End If
End Sub

Sub PressArr(A() As Integer, n As Integer)
      m% = UBound(A, 1)
      p% = LBound(A, 1)
      i_From% = p%
      i_To% = p%
      Do
           If i_From% > m% Then Exit Do
           If (A(i_From%) <> 0) And (i_From% <> i_To%) Then
              A(i_To%) = A(i_From%)
              i_To% = i_To% + 1
              i_From% = i_From% + 1
           ElseIf (A(i_From%) = 0) Then
              i_From% = i_From% + 1
           End If
       Loop
       n = i_To% - 1
End Sub

Sub PressArr(A() As Integer, n As Integer)
      m% = UBound(A, 1)
      p% = LBound(A, 1)
      i_From% = p%
      i_To% = p%
      Do
           If i_From% > m% Then Exit Do
           If (A(i_From%) > 0) And (i_From% <> i_To%) Then  '::: поправим !!!
              A(i_To%) = A(i_From%)
              i_To% = i_To% + 1
              i_From% = i_From% + 1
           ElseIf (A(i_From%) < 0) Then  '::: поправим !!!
              i_From% = i_From% + 1
           End If
       Loop
       n = i_To% - 1
End Sub

Sub PressArr(A() As Integer, n As Integer)
      m% = UBound(A, 1)
      p% = LBound(A, 1)
      i_From% = p%
      i_To% = p%
      Do
           If i_From% > m% Then Exit Do
           If (A(i_From%) >= 0) Then  
              If i_From% <> i_To% Then A(i_To%) = A(i_From%)
              i_To% = i_To% + 1
              i_From% = i_From% + 1
           ElseIf (A(i_From%) < 0) Then
              i_From% = i_From% + 1
           End If
       Loop
       n = i_To% - 1
End Sub
 
Sub Test()
Dim Z(-1 To 6) As Integer
 
    Z(-1) = 0
    Z(0) = 0
    Z(1) = -1
    Z(2) = 9
    Z(3) = -9
    Z(4) = 7
    Z(5) = -6
    Z(6) = 19
 
    PressArr Z(), k%
   
    For i% = -1 To k%
        Debug.Print i%; " "; Z(i%)
    Next i%
End Sub

Sub PressArr(A() As Integer, n As Integer)
      m% = UBound(A, 1)
      p% = LBound(A, 1)
      i_From% = p%
      i_To% = p%
      Do Until i_From% > m% 'Так красивее
           If A(i_From%) >= 0 Then  
              If i_From% <> i_To% Then A(i_To%) = A(i_From%)
              i_To% = i_To% + 1
              i_From% = i_From% + 1
           ElseIf A(i_From%) < 0 Then
              i_From% = i_From% + 1
           End If
       Loop
       n = i_To% - 1
End Sub

Private Sub Command1_Click()
Cls
n = 10
ReDim A(1 To n)
For i = 1 To n
A(i) = Int(Rnd * 11) - 5
Next i
 
pr A()
 
sm A(), 1, k
 
If k = 0 Then
 Print "{0}"
Else
 ReDim Preserve A(1 To k)
 pr A()
End If
 
End Sub
Sub pr(A())
For i = LBound(A) To UBound(A)
    Print A(i); " ";
Next i
Print
End Sub
 
Sub sm(A(), m, k)
If m > UBound(A) Then Exit Sub
If A(m) >= 0 Then
    k = k + 1: A(k) = A(m)
End If
sm A(), m + 1, k
End Sub