This is something I wrote to sort rows of information in a spreadsheet.
If you adapt it to what you're doing it should be faster. Let me know
what you think. - Pikus

Sub RankByCount(ctrStart As Long, ctrEnd As Long)

Dim foo As Integer
Dim bar As Integer
Dim fizz As Integer
Dim nums As Worksheet

Set nums = Worksheets("FinalNumbers")
bar = ctrStart

Do
foo = 0
fizz = -100
For x = bar To ctrEnd
If nums.Cells(x, 7).Value = fizz Then
foo = x
fizz = nums.Cells(x, 7).Value
End If
Next x

If foo < bar And foo < 0 Then
nums.Rows(foo).Cut
nums.Rows(bar).Insert
End If

bar = bar + 1
Loop Until bar = ctrEnd

End Sub


---
Message posted from http://www.ExcelForum.com/