Optimize a color sorting recorded code

[Newbie73]

Hello everyone,

I've recorded a macro to automate a fairly simple sorting action, however it still takes a long time to process it due to the dimension of the data.

Is there a way to optimize the following code or is it likely to be due to the amount of data of the spreadsheet?

Sheets("Summary").Select
    Range("C25").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("C25:O5259").Select
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add(Range("C25:C5259"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(112, 48 _
        , 160)
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add(Range("C25:C5259"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(192, 0 _
        , 0)
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add(Range("C25:C5259"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        199, 206)
    With ActiveWorkbook.Worksheets("Summary").Sort
        .SetRange Range("C25:O5259")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Happy to provide a small spreadsheet as example if necessary. Might just be due to all the data anyway but I thought in asking just in case.

Thanks!

 

[DanteAmor]

Try this:

Sub sort_data()
  Dim lr As Long
  
  Sheets("Summary").Select
  lr = Range("C" & Rows.Count).End(3).Row
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  
  With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add(Range("C25:C" & lr), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(112, 48, 160)
    .SortFields.Add(Range("C25:C" & lr), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(192, 0, 0)
    .SortFields.Add(Range("C25:C" & lr), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 199, 206)
  
    .SetRange Range("C25:O" & lr)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[Micron]

@DanteAmor, would you be so kind to explain to an Excel vba novice why it is OK to sort the same range of 5000+ rows 3 different ways?

    .SortFields.Add(Range("C25:C" & lr), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(112, 48, 160)
    .SortFields.Add(Range("C25:C" & lr), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(192, 0, 0)
    .SortFields.Add(Range("C25:C" & lr), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 199, 206)

I just can't imagine why. The 3rd sort would over-ride the second; the second would over-ride the first? What am I missing?
TIA.

 

[Peter_SSs]

The 3rd sort would over-ride the second; the second would over-ride the first? What am I missing?

They are not 3 different sorts. There is just one sort. The 3 code lines that you have quoted are specifying that when the one sort is performed, which colour is sorted to the top, which colour 2nd and which colour 3rd. If you set up some sample data with the relevant colours given scattered throughout and run it you will see the result. Also, if you then manually look in the 'Sort' option on the 'Data' ribbon tab you would see this.

 

[DanteAmor]

@DanteAmor, would you be so kind to explain to an Excel vba novice why it is OK to sort the same range of 5000+ rows 3 different ways?

In this case the colors are ordered according to the sequence you entered:

For example, before:

After:

 

[Newbie73]

Thanks DanteAmor! Working better now