Sub Sort()

ActiveSheet.Range("A1").Activate

Dim arr()

Dim i As Integer

i = 0

For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

i = i + 1

ReDim Preserve arr(i)

arr(i) = ce.Value

Next ce

Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents

For i = LBound(arr) To UBound(arr)

Set findit = Range("B:B").Find(what:=arr(i))

findit.Offset(0, -1).Value = arr(i)

Next i

End Sub

This is very close to working perfectly, but I ran into one little glitch and I was hoping for some help. Let's assume that one of the cells in column A is 3. Let's also assume that one of the cells in column B is 3 and another one is 31. If 31 is ahead of 3 in the column, it will get matched up with the 3 in column A instead of the 3 in column B. Does anyone know why this macro is doing this, and what I can do to fix it?

Thanks,

-Rave