Public Sub CleanArray()

Dim x, y As Variant
Dim i, c As Integer

'Dump all values in a range to an array
y = Sheets("Sheet1").Range("A1:A175")
x = y

Erase x    'reset the new array elements

'Weed out the blanks in the array
i = 1  'counter for old array
c = 0  'counter for new array

While i < 175
    If Not IsEmpty(y(i, 1)) Then
       c = c + 1
       ReDim Preserve x(c, 1) 'This one doesn't work
       x(c, 1) = y(i, 1)
    End If
    i = i + 1

Wend

End Sub

ReDim Preserve x(1, c)  'Instead of x(c, 1)