Sort and Separate Data

[trevor2524]

Hello Does anybody know how to code a macro that will Sort an entire Sheet with headers by Cell color Value.
Clear Value Followed by Yellow Followed by Red

Then after that it will go Down Column A and everytime there is a different value from one cell to the next it will insert a Row. This way it separates the data for me.

Any Ideas?

Thanks.

 

[Megster]

The following code should sort the sheet by the colour of the cells in the first row of the worksheet:

Sub SortByColour()

Dim colour_code As Integer
Dim i As Integer

'inserts new row above header row
Rows("1:1").Select
Selection.Insert Shift:=xlDown

'records the colour code of each colomn in the new row
i = 1
Do
Cells(2, i).Select
colour_code = ActiveCell.Interior.ColorIndex
Cells(1, i).Value = colour_code
i = i + 1
Loop Until i = 257

'sort columns according to code
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal

'delete row above headers
Rows("1:1").Select
Selection.Delete Shift:=xlUp


End Sub

 

[trevor2524]

Thanks Megster for the response. Is there a way to switch this code to sort by the colors in the Rows and not the Columns. I have Rows that are different colors not the columns. So right now when I run this macro everything stays the same.

 

[Megster]

Try this one:

Sub SortByColour()


Dim colour_code, i, last_row As Integer


'find last row in sheet
last_row = Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row


'inserts new column
Columns("A:A").Select
Selection.Insert Shift:=xlLeft
Range("A1").Value = "Colour Index"


'records the colour code of each row in the new column
i = 2
Do
Cells(i, 2).Select
colour_code = ActiveCell.Interior.ColorIndex
Cells(i, 1).Value = colour_code
i = i + 1
Loop Until i = last_row + 1


'sort cells by row colour
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


End Sub