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