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

THANK YOU and also for the comments about the speed.

Perhaps I should think of a better index for sorting, then just color code
the result.

"Jim Thomlinson" wrote:

> 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

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" <(E-Mail Removed)> wrote in message
news:1ACC2D00-88CF-48C9-88A6-(E-Mail Removed)...
> 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

Peter T
WOW is all I can say. These mods made it lightin' FAST!!!

Thanks

"Peter T" wrote:

> 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" <(E-Mail Removed)> wrote in message
> news:1ACC2D00-88CF-48C9-88A6-(E-Mail Removed)...
> > 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
>
>
>