A difficult sort

is this what you need

Sorting1.xlsm

Thanks to both of you, you've given me many good tips. WHER seems to be closest to what I need though, at this point. To further my problem... You have "Hard-coded" the column "A" listing and the listing in column "C". These change daily and might be W12X336, W14X99, etc... the list in column "C" is weights available while the "W40" is a width size. If these change from day to day, how could I use your code to be more "generic" in that regard? Also the list in column "A" could be from 4 to 30 lines. Column "B" will alsways be static. Column "C" could be from 1 to 20 lines.
I'm going to start working with what I have from now and see what I can do with it.

Thanks again,

Doug

Attachment in post 3 replaced, to reflect your comments above.

Try the attached.

This code is capable to handle the records that doesn't match to the list.
(list those to the last)

Option Explicit

Sub test()
    mySort
    AddSheet
End Sub

Private Sub mySort()
    Dim a, i As Long, ii As Long, SL As Object
    Dim myNum As String, Grade, w
    Set SL = CreateObject("System.Collections.SortedList")
    ReDim w(1 To 2)
    With Sheets("Lists").Range("a1").CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            If a(i, 3) <> "" Then
                a(i, 3) = CStr(a(i, 3))
                If Not SL.contains(i) Then
                    w(1) = a(i, 3)
                    Set w(2) = CreateObject("System.Collections.ArrayList")
                    SL(i) = w
                End If
                w = SL(i)
                For ii = 2 To UBound(a, 1)
                    If a(ii, 2) <> "" Then
                        a(ii, 2) = Replace(a(ii, 2), "-", "")
                        w(2).Add a(ii, 2)
                        SL(i) = w
                    Else
                        Exit For
                    End If
                Next
            Else
                Exit For
            End If
        Next
        ReDim Preserve a(1 To UBound(a, 1), 1 To 1)
        ReDim Preserve a(1 To UBound(a, 1), 1 To 2)
        For i = 2 To UBound(a, 1)
            myNum = "zzz": Grade = "zzz"
            If a(i, 1) Like "*X*" Then
                myNum = Val(Mid$(a(i, 1), InStr(1, a(i, 1), "X", 1) + 1))
            End If
            If a(i, 1) Like "* *" Then
                Grade = Replace(Split(a(i, 1) & "-")(1), "-", "")
            End If
            For ii = 0 To SL.Count - 1
                If SL.GetByIndex(ii)(1) = myNum Then
                    a(i, 2) = Format$(ii, "00000") & _
                    Format$(SL.GetByIndex(ii)(2).IndexOf(Grade, 0), "00000")
                    Exit For
                End If
            Next
            If a(i, 2) = "" Then a(i, 2) = "zzz" & a(i, 1)
        Next
        SL.Clear
        For i = 2 To UBound(a, 1)
            SL(a(i, 2)) = a(i, 1)
        Next
        For i = 0 To SL.Count - 1
            a(i + 2, 1) = SL.GetByIndex(i)
        Next
        .Resize(, 1).Value = a
    End With
End Sub

Private Sub AddSheet()
    Dim i As Long
    With Sheets("Lists")
        For i = .Range("a" & Rows.Count).End(xlUp).Row To 2 Step -1
            If Not IsSheetExists(.Cells(i, 1).Value) Then
                Sheets.Add(after:=Sheets("Lists")).Name = .Cells(i, 1).Value
            End If
            With Sheets(.Cells(i, 1).Value)
                .Move after:=Sheets("Lists")
                .Cells(1).Value = .Name
            End With
        Next
    End With
End Sub

Function IsSheetExists(ByVal txt As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(txt).Name)
    On Error GoTo 0
End Function

JINDON !!! Absolutely GREAT. Thanks. Not being a trained programmer, I stumble with quite a few of these tasks. But with the great help I get here, you guys/gals make a great difference. Thanks again, I'm just waiting for the chance to get to help someone else (maybe one of these days...).


HMMM..Can't find the "SOLVED" option.

You are welcome.

jindon,

I have run into a problem, and since this was your code, I figured you would be the best help. (Any help from anyone else is always appreciated.)

I have attached another workbook with a simple list and the trouble described.

Thanks,
Doug

I din't understand your intention of changing the code as such....

It is obvious to get the error since you haven't got all the sheets listed.

Ok, I was trying to conserve space by sending an abbreviated workbook. Attached is the workbook I'm developing. It has sheets that have been loaded and is now at the point of sorting the sheets and putting them in the sorted order.
When you open the workbook, you will be put into a select mode, just click "cancel" and then you can see what I'm running into.

I was running the sort routine manually until I get everything worked out.

The "Lists" is the original. I used the "Lists1" sheet because the info on the "Lists" sheet is not located the same as the other.

Thanks,

Doug

OK, since your data layouts are slightly different, try change to

        SL.Clear
        For i = 2 To UBound(a, 1)
            If a(i,1) <> "" Then SL(a(i, 2)) = a(i, 1)
        Next

Once again, many thanks. That works great!

Doug