If you incorporate the following modification your colour sort should be
pretty fast, even with 10k rows -

Change -
For i = 1 To BotRow
Range("A1").Offset(i, J) = Range("A1").Offset(i,
y).Interior.ColorIndex
Next

to -

Dim rng As Range, cel As Range
Set rng = Range("A1").Offset(, y).Resize(BotRow, 1)

ReDim arrClrIdx(1 To BotRow, 1 To 1) As Long
For Each cel In rng
i = i + 1
arrClrIdx(i, 1) = cel.Interior.ColorIndex
Next
Range("A1").Offset(, j).Resize(BotRow, 1) = arrClrIdx

I've tried to adapt with your variables and column to sort method, eg your
BotRow doesn't seem right -

BotRow = Range("A65536").Offset(0, y).End(xlUp).Row - 1
to
BotRow = Range("A65536").Offset(0, y).End(xlUp).Row

Best double check but hope you get the basic idea.

Also declare your other variables
Dim y As Long, j As Long, i As Long, BotRow As Long

Regards,
Peter T


"JHL" wrote in message
...
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