Home » excel » excel – Auto Sort overrides color sort

excel – Auto Sort overrides color sort

Posted by: admin April 23, 2020 Leave a comment

Questions:

I’m making a database for excel.
The goal is to have the data input into it Auto sort by color and then Alphabetically.

I’m using the following VBA to auto sort.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Range("A1").Sort Key1:=Range("A2"), _
          Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom

    End If

End Sub

And I’ve set up Macros for the color sorting as follows:

 With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveWorkbook.Worksheets("Master").ListObjects("Table2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Master").ListObjects("Table2").Sort.SortFields.Add( _
        Range("Table2[Name]"), xlSortOnCellColor, xlDescending, , xlSortNormal). _
        SortOnValue.Color = RGB(255, 0, 0)
    With ActiveWorkbook.Worksheets("Master").ListObjects("Table2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

The problem is once I input new data, the alphabetical sort overrides the color sort.

Can someone please help me make it so that the color sorting overrides the alphabetical?

Any help is greatly appreciated!

How to&Answers:

When you set the Range.Sort property directly like that, it removes the existing SortFields

Optional step: Loop through and remove any SortFields where .SortOn is not SortOnCellColor to remove any non-colour sorting

To add the sort at the end, you want to just add a new SortField, just like you are already doing for the colours, and then apply the sorting:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        'Add new SortField to end of existing Sorts
        Me.ListObjects("Table2").Sort.SortFields.Add Key:=Me.Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        'Apply new SortFields
        Me.ListObjects("Table2").Sort.Apply
    End If
End Sub

Then, go through and remove all references to ActiveWorkbook from the rest of your code.