BucketSort (really really fast)

<pre>
Private Sub Form_Load()
 Dim MyArr(99999) As Long
 Dim i As Long
 Dim t As Variant
 
 For i = LBound(MyArr) To UBound(MyArr)
  MyArr(i) = Rnd * 99999
 Next
 MsgBox "Click OK to start"
 t = Timer
 BucketSort MyArr
 MsgBox "READY!!!" & vbCrLf & "sorted 100000 values in " & Timer - t & " seconds"
 For i = LBound(MyArr) To UBound(MyArr)
  List1.AddItem MyArr(i)
 Next
End Sub
Private Sub BucketSort(ByRef Arr() As Long)
 Dim Buckets(99999) As Long
 Dim i As Long
 Dim j As Long
 Dim pos As Long
 
 For i = LBound(Arr) To UBound(Arr)
  Buckets(Arr(i)) = Buckets(Arr(i)) + 1
 Next
 pos = 0
 For i = LBound(Buckets) To UBound(Buckets)
  Do While Buckets(i) > 0
   Arr(pos) = i
   Buckets(i) = Buckets(i) - 1
   pos = pos + 1
  Loop
 Next
End Sub
</pre>