excelvbasorting

Sorting in VBA with two custom lists

I have a worksheet that I want to sort by two custom lists, vCustom_Sort1 and vCustom_Sort2. My code is below, formed from snippets I have found elsewhere.

  Set ws = ActiveWorkbook.Worksheets("Daily Cover")

  'Creating the arrays to sort by
  vCustom_Sort1 = Array("^&^", "PPA", "LM_*")
  Application.AddCustomList ListArray:=vCustom_Sort1
  vCustom_Sort2 = Array("Teacher", "HoC", "HoY")
  Application.AddCustomList ListArray:=vCustom_Sort2

  With ws
     rr = .Cells(.Rows.Count, "A").End(xlUp).Row

     .Sort.SortFields.Clear

     With .Range("A1:O" & rr)
         .Cells.Sort Key1:=.Columns(iCol), Order1:=xlAscending, DataOption1:=xlSortNormal, _
                            Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, _
                            OrderCustom:=Application.CustomListCount + 1, Key2:=.Columns(5),             
                            Order1:=xlAscending, DataOption1:=xlSortNormal, _
                            Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, _
                            OrderCustom:=Application.CustomListCount + 2

          End With
     .Sort.SortFields.Clear
   End with

The first sort works fine (the vCustom_Sort1), but the second sort (vCustom_Sort2) does not work properly - it puts 'HoC' first, then 'HoY', and 'Teacher' last, which is the correct order but 'Teacher' has been added last rather than first. Can anyone offer any ideas as to why, please? Thank you!

Solution

  • You may want to get the correct custom list number and perhaps remove the entries after sorting. Here's a quick suggestion (based on recording a macro): (Please adjust the key columns A2 and E2 to match your data)

    Sub CustomSort()

    vCustom_Sort1 = Array("^&^", "PPA", "LM_*")
    Application.AddCustomList ListArray:=vCustom_Sort1
    CustomOrder1 = Application.GetCustomListNum(Array(vCustom_Sort1))
    
    vCustom_Sort2 = Array("Teacher", "HoC", "HoY")
    Application.AddCustomList ListArray:=vCustom_Sort2
    CustomOrder2 = Application.GetCustomListNum(Array(vCustom_Sort2))
  
    Set ws = ActiveWorkbook.Worksheets("Daily Cover")
    rr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ws.Sort.SortFields.Clear
    
    ws.Sort.SortFields.Add Key:=Range( _
        "A2"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CustomOrder1, _
        DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=Range( _
        "E2"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CustomOrder2, _
         DataOption:=xlSortNormal
    With ws.Sort
        .SetRange Range("A1:O" & rr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ws.Sort.SortFields.Clear
    
    Application.DeleteCustomList CustomOrder2
    Application.DeleteCustomList CustomOrder1
    
    Set ws = Nothing
End Sub

    Result