Well... Custom Sort Lists are almost easier to use in the GUI vs VBA. There are a few things I want to note before I move on.
There is a twist between .Cells.Sort.SortFields.Add and .Cells.Sort that usually generates some confusion. The .SortFields.Add method uses a CustomOrder:= parameter and the Range.Sort method uses a OrderCustom:= parameter. The two are most definitely NOT the same but often get used interchangeably with disastrous results.
https://stackoverflow.com/a/32682618/5079799
I found that I could not get OrderCustom
to work as it always sorted either via xlAscending/Descending
which the whole point of this exercise is I want to sort my output in a non alphanumerical way. (But this would be my preferred way, and reference the Custom List via it's "integer value")
I also spent a lot of time reading this article, which teaches about creating/saving/finding/delete Custom Order lists. But, I couldn't actually find a way to use a list I "created".
https://exceloffthegrid.com/vba-for-customlists-autofill-lists/
In the end I just used a simple "For Loop" to generate a String from each cells value in the "Custom Column" in the format of "One,Two,Three" and fed that to CustomOrder:=CVar(CustomOrderStr)
make sure to use CVar
!
Here is the code, note lots of this isn't needed, but I left it all for posterity:
Functions:
Public Function CustomOrderStrFromRng(rng As Range) As String 'Generate String for "CustomOrder:="Str1,Str2" For Each rcell In rng.Cells CustomOrderStrFromRng = CustomOrderStrFromRng & rcell.Value & "," Next rcell CustomOrderStrFromRng = Left(CustomOrderStrFromRng, Len(CustomOrderStrFromRng) - 1) End Function
Public Function CustomListFromRange(rng As Range) As Integer 'Either Create or Return Int Value for Custom List Dim CustomListArr As Variant CustomListArr = RangeToArray(rng) On Error Resume Next Application.AddCustomList ListArray:=Array(CustomListArr) On Error GoTo 0 CustomListFromRange = Application.GetCustomListNum(Array(CustomListArr)) Debug.Print "Custom List Int = " & CustomListFromRange End Function
Public Function NumberOfCustomLists() As Integer NumberOfCustomLists = Application.CustomListCount Debug.Print "NumberOfCustomLists = " & NumberOfCustomLists End Function
Public Sub DelCustomList(ListInt As Integer) Application.DeleteCustomList listNum:=ListInt End Sub
Public Function lRowOfCol(Optional ByVal ColNum As Long, Optional ByVal ColLet As String, Optional ByVal Endxl As String) As Long If StrComp(Endxl, "DOWN", vbTextCompare) = 0 Then If ColNum > 0 Then lRowOfCol = Cells(1, ColNum).End(xlDown).Row Else lRowOfCol = Range(ColLet & "1").End(xlDown).Row End If Else If ColNum > 0 Then lRowOfCol = Cells(Rows.Count, ColNum).End(xlUp).Row Else lRowOfCol = Range(ColLet & Rows.Count).End(xlUp).Row End If End If End Function
Public Function RangeToArray(rng As Range) As Variant Dim i As Long, r As Range ReDim arr(1 To rng.Count) i = 1 For Each r In rng arr(i) = r.Value i = i + 1 Next r RangeToArray = arr End Function
Subs:
Public Sub CustomSortDataFromColumn(DataRng As Range, CustomListColStr As String, KeyColStr As String) Dim CustomListCol As Range, CustomListCollRow As Integer, CustomListColInt As Integer Dim KeyCol As Range, KeyCollRow As Integer, KeyColInt As Integer CustomListColInt = Columns(CustomListColStr).Column CustomListCollRow = lRowOfCol(CustomListColInt) Set CustomListCol = Range(Cells(2, CustomListColInt), Cells(CustomListCollRow, CustomListColInt)) KeyColInt = Columns(KeyColStr).Column KeyCollRow = lRowOfCol(KeyColInt) Set KeyCol = Range(Cells(2, KeyColInt), Cells(KeyCollRow, KeyColInt)) Dim CustomOrderStr As String CustomOrderStr = CustomOrderStrFromRng(CustomListCol) ActiveSheet.Sort.SortFields.Clear ActiveSheet.Sort.SortFields.Add Key:=KeyCol, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CVar(CustomOrderStr) With ActiveSheet.Sort .SetRange DataRng .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub
Public Sub Test_CustomSortDataFromColumn() Dim DataRng As Range, CustomListCol As String, KeyCol As String Set DataRng = Range("A1:G70") CustomListCol = "I" KeyCol = "E" Call CustomSortDataFromColumn(DataRng, CustomListCol, KeyCol) End Sub
Public Sub TestingCustomLists() Dim NoOfLists As Integer NoOfLists = NumberOfCustomLists() Dim CusListRng As Range, CusListInt As Integer Set CusListRng = Range("I2:I70") CusListInt = CustomListFromRange(CusListRng) Debug.Print "CusListInt = " & CusListInt NoOfLists = NumberOfCustomLists() Call DelCustomList(CusListInt) NoOfLists = NumberOfCustomLists() End Sub
Public Sub SortRangeByCustomList() Dim DataRng As Range, CustomListCol As Range, KeyCol As Range Set DataRng = Range("A1:G70") Set CustomListCol = Range("I2:I70") Set KeyCol = Range("E2:E70") Dim CustomOrderStr As String CustomOrderStr = CustomOrderStrFromRng(CustomListCol) ActiveSheet.Sort.SortFields.Clear ActiveSheet.Sort.SortFields.Add Key:=KeyCol, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CVar(CustomOrderStr) With ActiveSheet.Sort .SetRange DataRng .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub