Color Sort
 

This is going to take a long time to run no matter what you do... here it is
with a couple of tweaks but it is going to be a slow process

Sub ColorSorter()
dim y as long
dim J as long
dim BotRow as long

Application.Screenupdating = false

y = ActiveCell.Column - 1
J = Range("IV1").End(xlToLeft).Column
BotRow = Cells(rows.count, "A").Offset(0, y).End(xlUp).Row - 1

Range("A1").Offset(0, J) = "Sort"
For i = 1 To BotRow
Range("A1").Offset(i, J) = Range("A1").Offset(i,
y).Interior.ColorIndex
Next i
Cells.Sort Key1:=Range("A1").Offset(0, J), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns(J + 1).Delete
Application.Screenupdating = true

End Sub
--
HTH...

Jim Thomlinson


"JHL" wrote:

Hello,
the following code should sort by color. However, if the spreadsheet is
large the macro runs a very long time. Will someone write some code that's
more efficient for large spreadsheets, say over 10K lines?

Thank you.
JHL

Sub ColorSorter()
y = ActiveCell.Column - 1
J = Range("IV1").End(xlToLeft).Column
BotRow = Range("A65536").Offset(0, y).End(xlUp).Row - 1

Range("A1").Offset(0, J) = "Sort"
For i = 1 To BotRow
Range("A1").Offset(i, J) = Range("A1").Offset(i,
y).Interior.ColorIndex
Next
Cells.Sort Key1:=Range("A1").Offset(0, J), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns(J + 1).Delete
End Sub