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