Multiple Color Sorts in Worksheet

[signoreexcel]

<tbody>
[TD="class: votecell"]

​

[/TD]
[TD="class: postcell"] I am doing the same sort repeatedly in the same worksheet, only the rows are changing. I am basically sorting the worksheet section-by-section (each section being a group of contiguous rows).
The repeated sort is actually 4 similar sorts. All four sorts are of columns D through R and are sorts by cell color.

1. First sort by cell color putting light red (255, 199, 206) at the top.
2. Second sort puts dark red (dark red 192, 0, 0) at top.
3. Third sort puts light green (198, 239, 206) at the bottom.
4. Fourth sort puts dark green (79, 98, 40) at the bottom.

With each sort the rows change, but the rows are always contiguous.
I have the below code, but I would like to lessen the amount of code in order to shorten the time needed to make changes for a different worksheet or different range. For example, instead of two lines of code for each column, I would like to include all columns in 1 or 2 lines of code. Can this be done with a loop ?
Also, what happens if the color I am sorting on is not found in a column? In the example below, dark red was not found in columns E, F, G, H, I, Q or R, so I sorted on light red instead. This is easy to see in the pull down menus of the sort function, but how to deal with it with VBA code ? Is there a way to use code to first check for the color ?


<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Sub ColorSort()
'
' ColorSort Macro
'
Range("A2341:Y2368").Select

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add Key:=Range( _
"D2341:D2368"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"E2341:E2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"F2341:F2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"G2341:G2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"H2341:H2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"I2341:I2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"J2341:J2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"K2341:K2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"L2341:L2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"M2341:M2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"N2341:N2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"O2341:O2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"P2341:P2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(192,0,0)

ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"Q2341:Q2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)
ActiveWorkbook.Worksheets("Sheet24 (4)").Sort.SortFields.Add(Range( _
"R2341:R2368"), xlSortOnCellColor, xlAscending,, xlSortNormal).SortOnValue. _
Color = RGB(255,199,206)

With ActiveWorkbook.Worksheets("Sheet24 (4)").Sort

.SetRange Range("A2341:Y2368")
.Header = xlGuess
.MatchCase =False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply

End With

End Sub</code>
[/TD]

</tbody>

 

[Joe4]

Cross-posted here: https://stackoverflow.com/questions/47662618/excel-vba-to-automate-sort-by-color#

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.