Custom Sort - problem with a comma in an entry

[zookeepertx]

Hello all!

I'm trying to set up a custom sort in VBA, but I ran into a problem. I'm establishing the array to use for the sort and it's fine except that one of the items being sorted is called "Invoice, Commercial" and it's affecting the sort, since there are commas separating the array elements. Here's the full custom list:

"Broker's Invoice,Bill of Lading,Cargo Release,Invoice,Commercial,Packing List,CF 7501,Rated Invoice,Delivery Order,Receiving,Payment (Debit) Advice,FWS3177,CITES,NMG Audit,Checklist,CF 7501-REVISED", _
DataOption:=xlSortNormal

Also, VBA doesn't seem to want to let me wrap that long list to encompass 2-3 lines in the code. Does it just HAVE to string out way to the right or is there some way other than space/underscore/enter?

Thank you!

Jenny

 

[MoshiM]

Since you know where the comma will be then you can concatenate the 2 elements and place a comma in between.
Ex with a 1D Array called Arr starting at 0:

Arr(3)=Arr(3) &  "," & Arr(4)

For X= 4 to Ubound(Arr)-1'Adjust the value of the other elements to account for this change

     Arr(X)=Arr(X+1)
  
Next X
Redim Preserve Arr(Lbound(Arr) to ubound(Arr)-1)

 

[zookeepertx]

Since you know where the comma will be then you can concatenate the 2 elements and place a comma in between.
Ex with a 1D Array called Arr starting at 0:

Arr(3)=Arr(3) &  "," & Arr(4)

For X= 4 to Ubound(Arr)-1'Adjust the value of the other elements to account for this change

     Arr(X)=Arr(X+1)
  
Next X
Redim Preserve Arr(Lbound(Arr) to ubound(Arr)-1)

Thank you for the quick response!

Sadly, I'm having kind of a stupid day and have no idea how to incorporate your code into what I have. (Sorts take a ridiculous amount of code!! This macro is going to be HUGE! ) Would you have time to show me where I'd insert that in my current code?

Here is what I have for that part of the code:

Application.AddCustomList ListArray:=Array("Broker's Invoice", _
        "Bill of Lading", "Cargo Release", [B][COLOR=#ff0000]"Invoice", "Commercial"[/COLOR][/B], "Packing List", _
        "CF 7501", "Rated Invoice", "Delivery Order", "Receiving", "Payment (Debit) Advice", _
        "FWS3177", "CITES", "NMG Audit", "Checklist", "CF 7501-REVISED")
    
    ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort.SortFields.Clear
    
    ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort.SortFields.Add2 _
        Key:=Range("A2:A39"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort.SortFields.Add2 _
        Key:=Range("B2:B39"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort.SortFields.Add2 _
        Key:=Range("C2:C39"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort.SortFields.Add2 _
        Key:=Range("D2:D39"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:= _
        "Broker's Invoice,Bill of Lading,Cargo Release,Invoice,Commercial,Packing List,CF 7501,Rated Invoice,Delivery Order,Receiving,Payment (Debit) Advice,FWS3177,CITES,NMG Audit,Checklist,CF 7501-REVISED", _
        DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort.SortFields.Add2 _
        Key:=Range("E2:E39"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)").Sort
        .SetRange Range("A1:O39")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Is ALL of that code really necessary? Can I replace the long name of the worksheet with just ActiveSheet? (I'd try it on my own, but I'm always screwing things up and then it takes forever to just get the code back like it was before I stuck my fingers in it) And do all of the "ActiveWorkbook.Worksheets...." have to be there or couldn't some of them get consolidated by a "With" statement? (Syntax is NOT my friend and gets me all tangled up a lot of the time!)

Thank you for your help!

Jenny

 

[zookeepertx]

OH MY GOD! Did I mention that I'm an idiot?! I've got the wrong section highlighted red in that last post; it's the one farther down towards the bottom that's the problem. Sorry to be confusing!

Anyway, the last part of my post is still a question - about shortening up the code.

 

[MoshiM]

I have virtually no experience with custom sorts but msdn says you can supply an array for the list like you have done already.
What I did was to define the array beforehand and then use what I posted before.The following would be placed above what you have already

Dim Name_K() As String,WK as worksheet
Set WK=[COLOR=#333333]ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)")[/COLOR]
Name_K = Split("Broker's Invoice,Bill of Lading,Cargo Release,Invoice,Commercial,Packing List,CF 7501,Rated Invoice,Delivery Order,Receiving,Payment (Debit) Advice,FWS3177,CITES,NMG Audit,Checklist,CF 7501-REVISED", ",")
        
Name_K(3) = Name_K(3) & "," & Name_K(4)


For X = 4 To UBound(Name_K) - 1 'Adjust the value of the other elements to account for this change


     Name_K(X) = Name_K(X + 1)
  
Next X
        
ReDim Preserve Name_K(LBound(Name_K) To UBound(Name_K) - 1)

and then replace

Application.AddCustomList ListArray:=Array("Broker's Invoice", _
        "Bill of Lading", "Cargo Release", "Invoice", "Commercial", "Packing List", _
        "CF 7501", "Rated Invoice", "Delivery Order", "Receiving", "Payment (Debit) Advice", _
        "FWS3177", "CITES", "NMG Audit", "Checklist", "CF 7501-REVISED")

with

Application.AddCustomList ListArray:=Name_K

To address you question about the worksheet names, if you use the supplied code then replace all your

[COLOR=#333333]ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)")[/COLOR]

with WK

 

[MoshiM]

Try this

Dim Name_K() As String, WK As Worksheet
Name_K = Split("Broker's Invoice,Bill of Lading,Cargo Release,Invoice,Commercial,Packing List,CF 7501,Rated Invoice,Delivery Order,Receiving,Payment (Debit) Advice,FWS3177,CITES,NMG Audit,Checklist,CF 7501-REVISED", ",")


Name_K(3) = Name_K(3) & "," & Name_K(4)


For X = 4 To UBound(K) - 1 'Adjust the value of the other elements to account for this change


     Name_K(X) = Name_K(X + 1)


Next X

ReDim Preserve Name_K(LBound(Name_K) To UBoundName_K) - 1)
Application.AddCustomList ListArray:=Name_K
    

Set WK = ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)")

Application.AddCustomList ListArray:=Name_K
    
    
WK.Sort.SortFields.Clear


For X = 101 To 105


    Select Case X
    
        Case 104
            WK.Sort.SortFields.Add2 _
            Key:=Range(Chr(X) & 2 & ":" & Chr(X) & 39), SortOn:=xlSortOnValues, Order:=xlAscending, _
            CustomOrder:=Name_K, DataOption:=xlSortNormal
        Case Else
            WK.Sort.SortFields.Add2 _
            Key:=Range(Chr(X) & 2 & ":" & Chr(X) & 39), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
    
    End Select
    
Next X
       
    With WK
        .SetRange Range("A1:O39")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
       
End Sub

 

[MoshiM]

I made some typos: change the 4th line of code to

[COLOR=#333333]For X = 4 To UBound(Name_K) - 1 [/COLOR]

and the 7th to

ReDim Preserve Name_K(LBound(Name_K) To UBound(Name_K) - 1)

As well as For X= 101 to 105 to
For X= 65 to 69


Then remove the end sub at the end

 

[MoshiM]

I made some typos: change the 4th line of code to

[COLOR=#333333]For X = 4 To UBound(Name_K) - 1 [/COLOR]

and the 7th to

ReDim Preserve Name_K(LBound(Name_K) To UBound(Name_K) - 1)

As well as For X= 101 to 105 to
For X= 65 to 69


Then remove the end sub at the end

Case 104 should be case 68 as well sry

 

[zookeepertx]

For X = 4 To UBound(K) - 1 'Adjust the value of the other elements to account for this change

I'm sorry - I don't know what you mean here.

In fact, I'm having a TERRIBLE time getting clear on any of this! Seemed like a Sort would be a fairly nice easy thing, but this one is killing me! To make it worse, my co-worker needs this macro ASAP, so I'm feeling pressured and that makes it harder to figure things out.

 

[MoshiM]

I'm sorry - I don't know what you mean here.

In fact, I'm having a TERRIBLE time getting clear on any of this! Seemed like a Sort would be a fairly nice easy thing, but this one is killing me! To make it worse, my co-worker needs this macro ASAP, so I'm feeling pressured and that makes it harder to figure things out.

That was just me commenting on what that loop did and that you should replace the 4th line with code on it with that.

Dim Name_K() As String, WK As WorksheetName_K = Split("Broker's Invoice,Bill of Lading,Cargo Release,Invoice,Commercial,Packing List,CF 7501,Rated Invoice,Delivery Order,Receiving,Payment (Debit) Advice,FWS3177,CITES,NMG Audit,Checklist,CF 7501-REVISED", ",")


Name_K(3) = Name_K(3) & "," & Name_K(4)


For X = 4 To UBound(Name_K) - 1  'Adjust the value of the other elements to account for this change


     Name_K(X) = Name_K(X + 1)


Next X


ReDim Preserve Name_K(LBound(Name_K) To UBound(Name_K) - 1)
Application.AddCustomList ListArray:=Name_K
    
Set WK = ActiveWorkbook.Worksheets("Audit-raw data-trimmed (2)")


Application.AddCustomList ListArray:=Name_K
        
WK.Sort.SortFields.Clear


For X = 65 To 69


    Select Case X
    
        Case 68
            WK.Sort.SortFields.Add2 _
            Key:=Range(Chr(X) & 2 & ":" & Chr(X) & 39), SortOn:=xlSortOnValues, Order:=xlAscending, _
            CustomOrder:=Name_K, DataOption:=xlSortNormal
        Case Else
            WK.Sort.SortFields.Add2 _
            Key:=Range(Chr(X) & 2 & ":" & Chr(X) & 39), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
    
    End Select
    
Next X
       
    With WK
        .SetRange Range("A1:O39")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With