Level Sort by Cell Color then Numerical Ascending

bpdarrow · May 5th 2020

I've spent wayy too long searching for why my code isn't always working. The scenario is that I have a sheet (VGP) with Columns A:U. The number of rows is dynamic each time I use this. I need to sort the entire range by the cell color in Column M (RGB 255,0 ,0) so that they appear at the top of the sheet first. Then, I need Column L to sort the numerical values in ascending order. I have 2 bits of code in my macro that work with varying degrees of success. This first section works sometimes. Then doesn't. It will have Column L sorted in numerically ascending order, but Column M will be all over the place in whatever order Column L is in.

So I turned to trying to sort by the cell color, because the cells that populate with "CG Trip Risk" in Column M based on the formulas in that column fill with a red background. I end up with a similar result, where it doesn't seem to be sorting by cell color first. The second section of code below is this attempt.

The last section of code below contains the section above where the sort functions begin, where the formula is input that results in the "CG Trip Risk" string and the red background color. I've also included a sample file containing the sheet and data with how it looks after running the macro currently.

I've searched all over the interwebs and tried dozens and dozens of different combinations with the same result, what am I missing?! Thank you!

Code

'//First attempt, by cell value rather than color
Sheets("VGP").Range("A1:U" & Sheets("VGP").Range("A1").End(xlDown).Row).Sort _
Key1:=Sheets("VGP").Range("M:M"), Order1:=xl, _
key2:=Sheets("VGP").Range("L:L"), order2:=xlAscending, _
Header:=xlYes

'//Second Sort Code by Color

ActiveWorkbook.Worksheets("VGP").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("VGP").Sort.SortFields.Add(Range("M2"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
        , 0)
    ActiveWorkbook.Worksheets("VGP").Sort.SortFields.Add Key:=Range("L2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("VGP").Sort
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'//Code above sort sections
Columns("M:M").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("L:L").Select
    Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "# VINs to Exact Tier Attainment" '//Added this to re-define the "Diff(EligUnits-ReqToTrip)" header
    Columns("L:L").Select
    Selection.ColumnWidth = 10
    Columns("L:L").EntireColumn.AutoFit
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Total # CG Codes > # Units to Tier Attain"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(ISNUMBER(RC[1]), RC[1]>RC[-1]), ""CG Trip Risk"", """")"
    Selection.AutoFill Destination:=Range("M2:M" & Range("A" & Rows.Count).End(xlUp).Row)
    Range(Selection, Selection.End(xlDown)).Select '//This & 2 lines above autofill formula in M2 to range of A
    Columns("M:M").EntireColumn.AutoFit
    Columns("L:L").Select
    Selection.NumberFormat = "0"


Columns("M:M").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""CG Trip Risk"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End If

'Sheets("VGP").Range("A1:U" & Sheets("VGP").Range("A1").End(xlDown).Row).Sort _
'Key1:=Sheets("VGP").Range("M:M"), Order1:=xl, _
'key2:=Sheets("VGP").Range("L:L"), order2:=xlAscending, _
'Header:=xlYes
    
ActiveWorkbook.Worksheets("VGP").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("VGP").Sort.SortFields.Add(Range("M2"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
        , 0)
    ActiveWorkbook.Worksheets("VGP").Sort.SortFields.Add Key:=Range("L2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("VGP").Sort
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Display More

jolivanes · May 5th 2020

Have a peak at the following thread. Some good info in there.

loop through all sheets and sort by cell colour

bpdarrow · May 5th 2020

Ohh thank you so much. This is so close, I just need some help adapting it to my scenario. There are red cells in various columns, but I only want to sort color based on Column M and then ascending number in Column L next. And rather than loop through all sheets (there are 5 total) I only want this specific sheet. I think I've done that with requiring the ws.name to be the correct sheet name before applying sort. Here's what I have so far.

I'm planning to call this private sub from my main macro rather than integrate the code into my existing macro. Is that a good idea?

Code

Private Sub VGPCGSort()

Dim ws As Worksheet
Dim i As Integer
Dim lw As Long
 For Each ws In Sheets
    If ws.Name = "VGP" Then
 lw = ws.Range("A" & Rows.Count).End(xlUp).Row
 For i = 1 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
 ws.Sort.SortFields.Clear
 ws.Sort.SortFields.Add(Range(ws.Cells(1, i), ws.Cells(lw, i)), 1, 2, 1).SortOnValue.Color = RGB(255, 0, 0)
 ws.Sort.SetRange ws.Range(ws.Cells(1, i), ws.Cells(lw, i))
 ws.Sort.Apply
 Next i
 Next ws
End Sub

Display More

Level Sort by Cell Color then Numerical Ascending

Participate now!

Share

Tags