Custom sort with placeholders

[Stefano]

Hello everybody,
I have an annoying problem that I can't manage to solve...

In a technical data sheet I have list of entries that can be entered in casual mode.
My target is to have a macro that can sort them in an idential order across the data sheets of all products (more than 1000).

The problem is that I'd like to avoid a "custom list", because it will be too long.

The ideal thing would be to have a list like:
"INT|AGG, INT|TRANC, INT|MD*, SX-PCX|*, SI-PCS|*, INT|IMB, INT|TRASP"

where the blue entries are fixed, while the red ones starts with some characters and could end with different ones.

I've searched the forum and tried a lot of different solutions, but no one works.

Any idea how to solve this?
Thanks

[Stefano]

No ideas?
I attach a demo workbook with my code, that obviously doesn't work...

Sub listItems()
    ActiveSheet.Sort.SortFields.Clear
    Application.AddCustomList ListArray:=Array("INT|TRANC", "INT|AGGRAFF", "INT|*", _
        "SX-*", "RO-*", "BI-*", "INT|MD-FIN", "INT|IMBALLO", "INT|TRASP")
    
    ActiveSheet.Range("D6:O19").Sort _
        Key1:=ActiveSheet.Range("E6"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=Application.CustomListCount + 1
        
    Application.deleteCustomList Application.CustomListCount
    ActiveSheet.Sort.SortFields.Clear
End Sub

[Paul_Hossler]

Little round about

Option Explicit
Sub SpecialSort()
    Dim wsData As Worksheet
    Dim rData As Range
    Dim i As Long
    'set some variables
    Set wsData = ActiveWorkbook.Worksheets("Foglio1")
    Set rData = Range("E6:O19")
    
    
    'add a prefix to sort by
    
    '    010           020         030       040     050    060        070           080           090
    '"INT|TRANC", "INT|AGGRAFF", "INT|*", "SX-*", "RO-*", "BI-*", "INT|MD-FIN", "INT|IMBALLO", "INT|TRASP"
    
    Application.ScreenUpdating = False
    
    For i = 6 To 19
        With wsData.Cells(i, 5)
            Select Case .Value
                Case "INT|TRANC"
                    .Value = "010#" & .Value
                Case "INT|AGGRAFF"
                    .Value = "020#" & .Value
                Case "INT|MD-FIN"
                    .Value = "070#" & .Value
                Case "INT|IMBALLO"
                    .Value = "080#" & .Value
                Case "INT|TRASP"
                    .Value = "090#" & .Value
                Case Else
                    If Left(.Value, 4) = "INT|" Then
                        .Value = "030#" & .Value
                    ElseIf Left(.Value, 3) = "SX-" Then
                        .Value = "040#" & .Value
                    ElseIf Left(.Value, 3) = "RO-" Then
                        .Value = "050#" & .Value
                    ElseIf Left(.Value, 3) = "BI-" Then
                        .Value = "060#" & .Value
                    End If
            End Select
        End With
    Next i
    
    'sort
    With wsData.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rData.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rData
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'remove prefix
    For i = 6 To 19
        With wsData.Cells(i, 5)
            If Len(.Value) > 0 Then .Value = Right(.Value, Len(.Value) - 4)
        End With
    Next i
    Application.ScreenUpdating = True

End Sub

[Stefano]

Paul, your little round about works perfecly!! Thank you wery much.
Simple but clever

I will leave the post open for some more days just to see if someone has a differnt trick.

[snb]

Based on the file you posted:

Sub M_snb()
    sn = [E6:O19]
    sp = [E27:E39]
    st = [E6:E19]
    
    For j = 1 To UBound(sp)
       If sp(j, 1) <> "" Then c00 = c00 & "|" & Application.Match(sp(j, 1), st, 0)
    Next
    
    st = Application.Transpose(Split(Mid(c00, 2), "|"))
    Cells(50, 5).Resize(UBound(st), UBound(sn, 2)) = Application.Index(sn, st, [column(A:K)])
End Sub

[Stefano]

Interesting, but in this case I need an already ordered list to compare with, which I don't have in my data sheet