Bubble Sort in VBA

Option Explicit
Dim myarray(), lookuprange As Range
Dim myrng As Range, mycell, i As Integer, k As Integer, l As Integer, tempvar

Sub sortarrangeData()
Application.ScreenUpdating = False
ReDim myarray(countUnique(Sheets(1).Range("A2:A31")))
Set myrng = ThisWorkbook.Sheets(1).Range("A2:A31")
For Each mycell In myrng
        If mycell <> mycell.Offset(1, 0) Then
            myarray(i) = mycell
            i = i + 1
         
        End If
Next
i = 0
'bubble sort
For k = 0 To countUnique(Sheets(1).Range("A2:A31")) - 1
    For l = k + 1 To countUnique(Sheets(1).Range("A2:A31"))
         If myarray(k) > myarray(l) Then
            tempvar = myarray(k)
            myarray(k) = myarray(l)
            myarray(l) = tempvar
         End If
       
       
    Next
 
Next
For l = 1 To countUnique(Sheets(1).Range("A2:A31"))
 
    Set lookuprange = ThisWorkbook.Sheets(1).Cells.Find(myarray(l), LookIn:=xlValues, lookat:=xlWhole)
    'MsgBox myarray(l) & "Addess" & lookuprange.Address
    Cells(l + 1, 5) = myarray(l)
    Cells(l + 1, 6) = lookuprange.Offset(0, 1)
    Cells(l + 1, 7) = lookuprange.Offset(1, 1)
    Cells(l + 1, 8) = lookuprange.Offset(2, 1)
Next
End Sub


Function countUnique(rng As Range) As Long
Dim coll As New Collection
Dim cell As Variant

On Error Resume Next
    For Each cell In rng
     
        coll.Add CStr(cell.Value), CStr((cell.Value))

    Next
    countUnique = coll.Count
 
    Set coll = Nothing
End Function

https://docs.google.com/file/d/0B23eJ2xd9ODyWUtvbUpJZ08wbE0/edit?usp=sharing