Help with dynamic array in VBA

Hello, Could you help me please with this code:

Option Explicit
Option Base 1
Sub array_numbers()
    Dim i As Integer, x As Integer, y As Integer, c As Integer, d As Integer, vys As Single
    Dim ret As String, my_str As String
    Dim array1() As Integer
    i = 0
    c = 0
    d = 0
    ret = ""
    Do
        x = Val(InputBox("type number"))
            If x <> 0 Then
        ret = ret + Chr(10) + str(x)
            End If
        i = i + 1
        ReDim Preserve array1(i)
            If x < array1(i) Then
                d = d + 1
                my_str = my_str + str(x)
            End If
        array1(i) = x
    Loop While x <> 0
        MsgBox "Numbers are: " + ret + Chr(10) + "the smallest number is: " + my_str
End Sub

Program: Enter a series of numbers terminated by zero. Determine the smallest and write down how many times in a row repeats

Problems are: When I try my program with StepInto, Redim preserves pole(i) shows "subscript out of range", when i insert variable x to array1 at the end of program then it shows value of array1 properly but when program goes to ReDim preserve array1(i) then value is again 0. Array is still 0 and i canīt determine the smallest number (If x < array1(i) Then).

Sorry my english is bad.