VBA Code to Sort Columns Based on Custom List

[OilEconomist]

Hello and thanks in advance for any assistance. I am trying to sort a data set in terms of columns based on a Custom List, but I am getting an error which I have posted below.

The following is a sample data set:

Stocks - Analysis Tool - (Active).xlsm
	C	D	E
8	Inventory	Region	Fruit
9	22	Nebraska	Pear
10	100	Texas	Apple
11	2000	Florida	Orange
Test

This is what I would like the final output to look like:

Stocks - Analysis Tool - (Active).xlsm
	J	K	L
8	Fruit	Inventory	Region
9	Pear	22	Nebraska
10	Apple	100	Texas
11	Orange	2000	Florida
Test

I am getting the error "Run-time error '9': Subscript out of Range" on the following line:

       RngSort.Sort.SortFields.Add2 Key:=RngHdg, SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:=ArrayList(), DataOption:=xlSortNormal

Code:

Option Explicit

Sub SortTest()

 'Dimensining
    Dim ShtNmTest As String
    Dim RngHdg As Range, RngSort As Range, RngKey As Range
    Dim ArrayList() As Variant


  'Code
    
    'Setting sheet name
     ShtNmTest = "Test"
    
    
    'Setting ranges
     With Sheets(ShtNmTest)
        Set RngHdg = .Range(.Cells(8, 3), .Cells(8, 5))
        Set RngSort = .Range(.Cells(8, 3), .Cells(11, 5))
        Set RngKey = .Cells(8, 3) 'I probably don't need this line since I used RngHdg as the key, but here in the case that's part of the issue.
     End With

    
    'Custom List - the order I would like the columns to be re-arranged
     ReDim ArrayList(1 To 3) As Variant
     ArrayList(1) = "Fruit"
     ArrayList(2) = "Inventory"
     ArrayList(3) = "Region"
     
     SortPerHeaderF ShtNmTest, ArrayList, RngHdg, RngSort, RngKey
    
 'Display Updates On
    Application.DisplayAlerts = True

End Sub



Function SortPerHeaderF(ShtNm As String, ArrayList As Variant, RngHdg As Range, RngSort As Range, RngKey As Range) As Variant


 'Display Updates Off
    Application.DisplayAlerts = False
    
    
    'Custom List to Array
     Application.AddCustomList ListArray:=ArrayList


 'Code
 
    'Sort
     With Sheets(ShtNm)
        .Sort.SortFields.Clear
        RngSort.Sort.SortFields.Add2 Key:=RngHdg, SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:=ArrayList(), DataOption:=xlSortNormal
        
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
     End With
    
    'Clean-up
     Application.DeleteCustomList Application.CustomListCount


 'Display Updates On
    Application.DisplayAlerts = True

End Function

 

[kevin9999]

You're using more code than I would for this task. Please try the following (change the sheet name to suit).

Option Explicit
    Sub Custom_Sort()
    Dim Ws As Worksheet, LRow As Long, Rng As Range
    
    Set Ws = Worksheets("Test") '<< Change to actual sheet name
    LRow = Ws.Range("C:E").Find("*", , xlFormulas, , 1, 2).Row
    Set Rng = Ws.Range(Ws.Cells(8, 3), Ws.Cells(LRow, 5))
    
    Application.AddCustomList ListArray:=Array("Fruit", "Inventory", "Region")
    With Ws.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range(Ws.Cells(8, 3), Ws.Cells(8, 5)), _
        CustomOrder:=Application.CustomListCount
        .SetRange Rng
        .Orientation = xlLeftToRight
        .Apply
    End With
End Sub

 

[kevin9999]

I'd be keen to know if the code worked for you?

 

[OilEconomist]

I'd be keen to know if the code worked for you?

Thanks. Yes it worked. I will send some more details when I get a chance.

 

[kevin9999]

Thanks. Yes it worked. I will send some more details when I get a chance.

Excellent news, thanks for the feedback

 

[OilEconomist]

Excellent news, thanks for the feedback

Thanks once again @kevin9999. You indicated "You're using more code than I would for this task." It may seem that way because this was part of a much larger code. I simplified where I could and left other instances the same so I did not change the objective to where when I incorporated it into the original, it would work.

 

[kevin9999]

Glad it worked & thanks for the feedback

 

[kevin9999]

Actually, I just noticed that your preferred column order is in alphabetical order left to right anyway (Fruit, Inventory, Region) so I'm guilty of using too much code myself. The following would work just as well:

Sub test()

    Worksheets("Test").Range("A:C").Sort Key1:=Range("A8:C8"), Order1:=xlAscending, Orientation:=xlLeftToRight

End Sub

Unless of course, you have data above or below the sample you provided...

 

[OilEconomist]

Actually, I just noticed that your preferred column order is in alphabetical order left to right anyway (Fruit, Inventory, Region) so I'm guilty of using too much code myself. The following would work just as well:

Sub test()

    Worksheets("Test").Range("A:C").Sort Key1:=Range("A8:C8"), Order1:=xlAscending, Orientation:=xlLeftToRight

End Sub

Unless of course, you have data above or below the sample you provided...

Thanks @kevin9999, but I think my example coincidentally had the data that way, so I needed what your original solution provided.