Excel VBA custom sorting

Question

I have some sheet named for example ("CZLON") as below. It contains some data imported from the txt files or created manually:

I need that data to be sorted in a specific way:

First priority, by column "E" (if cell contains text with "S355" - 1st or "S235" - 2nd)

Second, by column "D". There is much more than 255 items in list so the standard excel sorting is not working properly.

I have created something like this (forgive me if something is wrong, I`m total VBA amateur):

Sub Sortuj_Czlon()

Application.ScreenUpdating = False

ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("E4" & Cells(Rows.Count, "E").End(xlUp).Row _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="S355,S235", _
DataOption:=xlSortNormal
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////
ActiveSheet.Sort.SortFields.Add Key:=Range("D4" & Cells(Rows.Count, "E").End(xlUp).Row _
), SortOn:=xlSortOnValues, Order:=xlDescending, CustomOrder:= _
"20x3,25x3,25x4,30x3,30x4,35x3,35x4,35x5,40x3,40x4,40x5,45x30x4,45x30x5,45x4," _
& "45x4,5,45x5,45x6,50x30x3,50x4,50x5,50x6,50x7,55x5,55x6,60x40x5,60x40x6,60x40x7,60x4," _
& "60x5,60x6,60x7,60x8,65x5,65x6,65x7,65x8,65x9,70x45x5,70x50x6,70x50x7,70x50x8,70x6," _
& "70x7,70x8,70x9,75x50x6,75x50x7,75x50x8,75x50x9,75x4,75x5,75x6,75x7,75x8,75x9," _
& "75x10,75x11,75x12,80x40x6,80x40x8,80x60x8,80x65x6,80x65x8,80x65x10,80x5,80x6," _
& "80x7,80x8,80x10,90x60x6,90x60x8,90x6,90x7,90x8,90x9,90x10,90x11,100x50x6,100x50x8," _
& "100x50x10,100x65x7,100x65x8,100x65x9,100x65x10,100x75x7,100x75x8,100x75x9,100x6,100x7," _
& "100x8,100x10,100x12,110x70x10,110x70x12,110x8,110x10,120x80x8,120x80x10,120x80x12,120x8," _
& "120x10,120x11,120x12,120x13,120x14,120x15,125x75x8,125x75x9,125x75x10,125x75x12,130x65x8," _
& "130x65x10,130x65x12,130x90x10,130x90x12,130x90x14,130x10,130x12,130x13,130x14,130x15,130x16," _
& "140x90x8,140x90x10,140x10,140x12,140x13,140x15,150x75x9,150x75x10,150x75x11,150x90x10,150x90x12," _
& "150x100x6,150x100x10,150x100x11,150x100x12,150x100x14,150x10,150x12,150x13,150x14,150x15,150x16,150x18," _
& "160x80x10,160x80x12,160x80x14,160x12,160x15,160x17,160x18,180x90x10,180x90x12,180x90x14,180x14," _
& "180x15,180x16,180x18,200x100x10,200x100x12,200x100x14,200x100x16,200x16,200x18,200x20,250x90x10," _
& "250x90x12,250x90x14,250x90x16" _
, DataOption:=xlSortNormal
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
With ActiveSheet.Sort
.SetRange Range("A4:G" & Cells(Rows.Count, "A").End(xlUp).Row)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Sort.SortFields.Clear
Application.ScreenUpdating = True
End Sub

In point of fact it is working but it is not comfortable for the other users to put some new data in custom list directly in VBA code (the list is not constant). So I want to create a new sheet with the list of items. Their order tells excel how to sort data in sheet "CZLON" (or some other). Something like this:

Can you please help me with this issue?

Answer 1

Try this:

CustomOrder:=SortItems

And add the following function to your module:

Function sortItems() As String
    Dim arrSort() As Variant
    Dim rngSort As Range
    Set rngSort = Worksheets("Sheet1").Range("A1").CurrentRegion 'Change sheet name and range if needed

    ReDim arrSort(1 To rngSort.Rows.Count)
    For i = 1 To UBound(arrSort)
        arrSort(i) = rngSort(i, 1)
    Next

    sortItems = Join(arrSort, ",")
End Function

If your list of items has a header, start the i counter at 2