why code gives error when just change range

[Hasson]

Hi
I have this code sort the data in sheet file based on sheet RP as in orginal code works , but when change the range from A: C to A: D will gives error in this line

Application.AddCustomList ListArray:=CustSort

as in picture

Sub test()
    Dim SortRng As Range, SortKey As Range
    Dim SortRng2 As Range, SortKey2 As Range
    Dim CustSort As Variant

    Set SortRng = Sheets("file1").Range("A1:D" & Sheets("file1").Range("A" & Rows.Count).End(xlUp).Row)
    Set SortKey = Sheets("file1").Range("B1")
  
    CustSort = Sheets("RP").Range("B2:B" & Sheets("RP").Range("B" & Rows.Count).End(xlUp).Row).Value
    Application.AddCustomList ListArray:=CustSort
    
    SortRng.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
    Application.DeleteCustomList Application.CustomListCount
End Sub

what's the mistake guys

 

[Colo]

Hi,
I can see that error when I'm about to add a Range object to the custom list, but in the code, a value property has been used to make it an array, so it should work...odd.
As another plan, instead of using a custom list, give using SortField objects a try if the situation allows.

Sub test2()
    Dim SortRng As Range, SortKey As Range
    Dim SortRng2 As Range, SortKey2 As Range
    Dim CustSort As Variant

    Set SortRng = Sheets("file1").Range("A1:D" & Sheets("file1").Range("A" & Rows.Count).End(xlUp).Row)
    Set SortKey = Sheets("file1").Range("B1")

    CustSort = Application.Transpose(Sheets("RP").Range("B2:B" & Sheets("RP").Range("B" & Rows.Count).End(xlUp).Row).Value)
    CustSort = Join(CustSort, ",")

    With SortRng.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=SortRng.Columns(1), CustomOrder:="" & CustSort & "", Order:=xlAscending
        .SetRange SortRng
        .Header = xlYes
        .Apply
    End With
End Sub

 

[Hasson]

thanks, but it doesn't seem to work , also doesn't show any error.

 

[Colo]

For testing, is it possible to post data and the expected results with XL2BB? It would be a great help.

 

[Hasson]

here is the data .

RESULT (1) (1).xlsm
	A	B
1	ITEM	ID
2	1	QQW-1 MM CLA1 23M-1 IT
3	2	QQW-2 TH NM-1 CLA2 VBG L CHI
4	3	QQW-3 CV CLA3 TAI
5	4	QQW-4 M*12.5 CLA4 TR
6	5	QQW-5 CLA5 EG
7	6	QQW-6 M230 TU
8	7	QQW-7 S** CLA7 US
9	8	QQW-8 CLA8 UK
10	9	QQW-9 CLA9 N BR
11	10	QQW-10 BN CLA10 IT
12	11	QQW-10 BN CLA10 IT -MM
13	12	QQW-11 LVD CH
14	13	QQW-12 CLA12 JA
15	14	QQW-13 CLA13 TR
16	15	QQW-13 CLA11 TR
17	16	QQW-14 L/R CLA14 SS230 EG
18	17	QQW-15 CLA5 EG
RP

RESULT (1) (1).xlsm
	A	B	C	D
1	ITEM	ID	IMP	EX
2	1	QQW-10 BN CLA10 IT -MM	12	12
3	2	QQW-11 LVD CH	23	1
4	3	QQW-12 CLA12 JA	12	2
5	4	QQW-13 CLA13 TR	45	5
6	5	QQW-7 S** CLA7 US	6	6
7	6	QQW-8 CLA8 UK	7	7
8	7	QQW-9 CLA9 N BR	8	8
file1

result

RESULT (1) (1).xlsm
	A	B	C	D
1	ITEM	ID	QTY	EX
2	1	QQW-7 S** CLA7 US	6	6
3	2	QQW-8 CLA8 UK	7	7
4	3	QQW-9 CLA9 N BR	8	8
5	4	QQW-10 BN CLA10 IT -MM	12	12
6	5	QQW-11 LVD CH	23	1
7	6	QQW-12 CLA12 JA	12	2
8	7	QQW-13 CLA13 TR	45	5
file1

remember this is dummy data but my real data are at least 1000 rows .
thanks for your time .

 

[Colo]

Changed the "key" columns for sorting to fit the actual worksheet.
It worked with the dummy data. Give it a try with your real data.

Sub test3()
    Dim SortRng As Range, SortKey As Range
'    Dim SortRng2 As Range, SortKey2 As Range
    Dim CustSort As Variant

    Set SortRng = Sheets("file1").Range("A1:D" & Sheets("file1").Range("A" & Rows.Count).End(xlUp).Row)
    Set SortKey = Sheets("file1").Range("B1")

    CustSort = Application.Transpose(Sheets("RP").Range("B2:B" & Sheets("RP").Range("B" & Rows.Count).End(xlUp).Row).Value)
    CustSort = Join(CustSort, ",")

    With SortRng.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=SortRng.Columns(2), CustomOrder:="" & CustSort & "", Order:=xlAscending
        .SetRange SortRng
        .Header = xlYes
        .Apply
    End With
End Sub

 

[Hasson]

thanks but after arranging data should also re-autonumber again in column A 1,2,3,...
how could be,please?

 

[Colo]

Just add the following code after sorting.

    ' re-autonumber
    With Sheets("file1").Range("A2")
        .Value = 1
        .AutoFill Destination:=.Resize(.End(xlDown).Row - 1), Type:=xlFillSeries
    End With

 

[bebo021999]

alternative code:

Option Explicit
Sub test()
Dim lr&
Worksheets("file1").Activate
lr = Cells(Rows.Count, "B").End(xlUp).Row
With Range("A2:A" & lr)
    .Formula = "=MATCH(B2,RP!B:B,0)"
    .Value = .Value
End With
Range("A2:D" & lr).Sort Range("A1")
Range("A2:A" & lr).Formula = "=COUNTA($B$2:B2)"
End Sub

 

[Hasson]

@Colo
great assistance !
many thanks buddy