Application Custom List

[pwill]

Hi, can anyone help with Application Custom List to Sort Data

I have a command button on sht2 with the following code to sort data on sht4 but excel will not save and crashes after running the macro. I have tried tinkering around a little with the code but keep getting errors.

For example I have tried changing the +2 to +6 in the code as there is 5 Default Custom Lists already exiting within excel and this allowed me to save after running the code but did not sort on sht4 the way it should?

Any help would be appreciated

Private Sub CommandButton110_Click()
    Dim Sht2 As Worksheet: Set Sht2 = Sheet02
    Dim Sht4 As Worksheet: Set Sht4 = Sheet04
    Dim ListNum As Long
    Dim lRowA As Long
    Dim lRowM As Long
    
        Application.ScreenUpdating = False
            
        lRowA = Sht4.Cells(Rows.Count, "A").End(xlUp).Row
        lRowM = Sht4.Cells(Rows.Count, "M").End(xlUp).Row
        
        Sht4.Range("A2:A" & lRowA) = _
            Sht4.Range("E2:E" & lRowA).Value
        Sht4.Range("M2:M" & lRowM) = _
            Sht4.Range("Q2:Q" & lRowM).Value
                
        ListNum = Application.CustomListCount + 2
        Application.AddCustomList Array("0", "1", "-1", "2", "-2", "3", "-3", "4", "-4", "5", "-5", "6", "-6", "7", "-7", "8", "-8", "9", "-9", "10", "-10", "11", "-11", "12", "-12", "13", "-13", "14", "-14", "15", "-15", "16", "-16", "17", "-17", "18", "-18", "19", "-19", "20", "-20", "21", "-21", "22", "-22", "23", "-23", "24", "-24", "25", "-25", "26", "-26", "27", "-27", "28", "-28", "29", "-29", "30", "-30", "31", "-31", "32", "-32", "33", "-33", "34", "-34", "35", "-35", "36", "-36", "37", "-37", "38", "-38", "39", "-39", "40", "-40", "41", "-41", "42", "-42", "43", "-43", "44", "-44", "45", "-45", "46", "-46", "47", "-47", "48", "-48", "49", "-49", "50", "-50", "51", "-51", "52", "-52", "53", "-53", "54", "-54", "55", "-55", "56", "-56", "57", "-57", "58", "-58", "59", "-59", "60")
            With Sht4
                .Range("A2:K" & lRowA).Sort Key1:=.Range("E2"), order1:=xlAscending, _
                    Header:=xlNo, OrderCustom:=ListNum
                .Range("M2:W" & lRowM).Sort Key1:=.Range("Q2"), order1:=xlAscending, _
                    Header:=xlNo, OrderCustom:=ListNum
            End With
        ListNum = ListNum - 1
        Application.DeleteCustomList ListNum
        
    Application.ScreenUpdating = True
    
End Sub

Regards


pwill
​

 

[Fluff]

Try adding this line

                 [COLOR=#ff0000] .Range("A1").Sort key1:=.Range("A1"), ordercustom:=1[/COLOR]
            End With

 

[pwill]

Thanks Fluff,

That almost worked, it did save this time but the sort came out wrong with "A:K" and sorted correct with "M:W"

ie the sort is in reverse with "A:K" and the headers have gone to the bottom​

	A	B	C	D	E	F	G	H	I	J	K		M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	-2	43258	3		-2	-3	-3	-4	6	-6	8		REF	Date	Cnt1	Cnt2	A	B	C	D	E	F	G
2	0	43257	1		0	1	1	-1	-5	-5	-6		0	43257	1		0	1	-1	-2	-16	18	-21
3	0	43258	2		0	1	-1	-3	-4	5	-5		0	43258	2		0	8	11	-11	13	17	35
4	0	43259	4		0	0	3	4	-5	9	10		0	43259	4		0	-1	2	-18	-20	-30	-31
5	0	43259	5		0	1	-1	-2	-2	4	5		0	43259	4		0	-2	-12	-13	17	18	20
6	0	43260	6		0	-2	3	-4	-5	6	-6		0	43259	5		0	-5	13	-21	-22	-27	-28
7	0	43260	7		0	1	-2	3	3	-4	-10		0	43260	6		0	-2	-6	7	-12	-25	-27
8	0	43261	8		0	0	0	1	2	5	6		0	43260	7		0	-1	-2	-3	8	9	18
9	0	43261	9		0	-1	2	-3	4	4	8		0	43261	8		0	2	5	-6	7	13	28
10	0	43262	10		0	0	-1	-2	3	5	6		0	43261	8		0	-6	-8	-11	-13	15	-19
11	0	43262	11		0	0	1	-1	2	4	-6		0	43261	8		0	-15	-21	-23	-26	-28	-34
12	0	43263	12		0	1	-2	4	-6	-7	8		0	43261	9		0	-1	7	20	29	30	35
13	REF	Date	Cnt1	Cnt2	A	B	C	D	E	F	G		0	43262	10		0	4	-16	17	-21	-26	-30
14													0	43262	10		0	-13	-17	-33	-38	-43	-47
15													0	43262	11		0	1	3	6	-11	-30	-31
16													0	43262	11		0	-1	2	5	-12	-31	-32
17													0	43263	12		0	1	2	-3	5	-23	-32
18													1	43257	1		1	2	3	4	-13	-18	21
19													1	43257	1		1	6	20	21	22	23	40
20													1	43258	2		1	9	-10	12	14	18	36
21													1	43259	5		1	2	-4	-5	18	23	36
22													1	43260	7		1	2	-7	-8	-9	-10	11
23													1	43261	8		1	7	9	12	14	20	35
24													1	43262	11		1	2	4	7	-10	-29	-30
25													1	43263	12		1	10	30	33	34	35	38
26													-1	43257	1		-1	-2	-3	-4	16	-18	-23
27
28

<tbody>
</tbody>

 

[pwill]

And I have the code as

Private Sub CommandButton110_Click()
    Dim Sht2 As Worksheet: Set Sht2 = Sheet02
    Dim Sht4 As Worksheet: Set Sht4 = Sheet04
    Dim ListNum As Long
    Dim lRowA As Long
    Dim lRowM As Long
    
        Application.ScreenUpdating = False
            
        lRowA = Sht4.Cells(Rows.Count, "A").End(xlUp).Row
        lRowM = Sht4.Cells(Rows.Count, "M").End(xlUp).Row
        
        Sht4.Range("A2:A" & lRowA) = _
            Sht4.Range("E2:E" & lRowA).Value
        Sht4.Range("M2:M" & lRowM) = _
            Sht4.Range("Q2:Q" & lRowM).Value
                
        ListNum = Application.CustomListCount + 2
        Application.AddCustomList Array("0", "1", "-1", "2", "-2", "3", "-3", "4", "-4", "5", "-5", "6", "-6", "7", "-7", "8", "-8", "9", "-9", "10", "-10", "11", "-11", "12", "-12", "13", "-13", "14", "-14", "15", "-15", "16", "-16", "17", "-17", "18", "-18", "19", "-19", "20", "-20", "21", "-21", "22", "-22", "23", "-23", "24", "-24", "25", "-25", "26", "-26", "27", "-27", "28", "-28", "29", "-29", "30", "-30", "31", "-31", "32", "-32", "33", "-33", "34", "-34", "35", "-35", "36", "-36", "37", "-37", "38", "-38", "39", "-39", "40", "-40", "41", "-41", "42", "-42", "43", "-43", "44", "-44", "45", "-45", "46", "-46", "47", "-47", "48", "-48", "49", "-49", "50", "-50", "51", "-51", "52", "-52", "53", "-53", "54", "-54", "55", "-55", "56", "-56", "57", "-57", "58", "-58", "59", "-59", "60")
            With Sht4
                .Range("A2:K" & lRowA).Sort Key1:=.Range("E2"), order1:=xlAscending, _
                    Header:=xlNo, OrderCustom:=ListNum
                .Range("M2:W" & lRowM).Sort Key1:=.Range("Q2"), order1:=xlAscending, _
                    Header:=xlNo, OrderCustom:=ListNum
                [COLOR=#ff0000].Range("A1").Sort key1:=.Range("A1"), ordercustom:=1[/COLOR]
            End With
        ListNum = ListNum - 1
        Application.DeleteCustomList ListNum
        
    Application.ScreenUpdating = True
    
End Sub

 

[pwill]

Try adding this line

                 [COLOR=#ff0000] .Range("A1").Sort key1:=.Range("A1"), ordercustom:=1[/COLOR]
            End With

Thanks Fluff,

I have managed to work it out, everything sorts as it should now and also allows me to save after running the code
This line did the trick

[COLOR=#ff0000][FONT=Verdana][LEFT]                             .Range("A1", "M1").Sort key1:=.Range("A1", "M1"), ordercustom:=1[LEFT][COLOR=#574123][FONT=monospace][I]            End With[/I][/FONT][/COLOR][/LEFT]
[/LEFT]
[/FONT][/COLOR]

thanks again

pwill
​