sort whole ranges based on selection multiple cells at once without any criteria

[abdo meghari]

Hi experts ,
I no know if this way could be sort it !

I want to sort the data based on my choices, where the data will be arranged based on who will be selected first for cells in column A , then the next based on the selection of a cell or several cells at the same time. In this case, it will be arranged in an orderly manner and if I select new data are not selected before then will copy directly to below data have already selected and sorted . And in the case of choosing the same elements that were previously organized, then they are organized again and make the ones below them rise to the top

original data

Elmarghanie Brand .xlsm
	A	B	C	D	E
1	ITEM	CODE	BRAND	PURCHASE	SELLING
2	1	CCR-1220	BS 1200 R20 18PR G580 THI		20
3	2	CCR-1221	BS 1200 R20 18PR G580 JAP	30	471
4	3	CCR-1222	BS 1200R20-18PR R187 JAP		9
5	4	CCR-1223	BS 1200R24 G580	50	8
6	5	CCR-1224	BS 1200R24 G582	2
7	6	CCR-1225	BS 13 R22.5 R187 JAP		4
8	7	CCR-1226	BS 1400R20 TCF R180 JAP		2
9	8	CCR-1227	BS 1400R20 TCF R180BZ JAP		4
10	9	CCR-1211	BS 1400R20VSJ TCF JAP	22	55
11	10	CCR-1212	BS 165 R13C R624 IND	4	4
12	11	CCR-1213	BS 175/70R13 EP150 THI		2
13	12	CCR-1214	BS 185/65R15 B250 JAP		2
14	13	CCR-1215	BS 185/65R15 T001 JAP		1
15	14	CCR-1216	BS 195/75R16C R613 JAP		6
16	15	CCR-1217	BS 195R14C 613 JAP		4
17	16	CCR-1218	BS 195R14C R623 THI		4
18	17	CCR-1219	BS 195R15C 613V JAP	4	4
19	18	CCR-1228	BS 205/60R16 T005 THI		8
20	19	CCR-1229	BS 205/70R15C R623 THI	8	405
21	20	CCR-1230	BS 205R16C D840 THI		26
22	21	CCR-1231	BS 215/50 R17 EP300 THI		10
23	22	CCR-1232	BS 215/55R17 T005 JAP		4
24	23	CCR-1233	BS 215/60R16 ER30 JAP	8	8
25	24	CCR-1234	BS 215/65R15 T005A IND	4	4
26	25	CCR-1235	BS 215/70R15C R624 HD109S107S 8 TURK		6
27	26	CCR-1236	BS 225/40R18PR 005A JAP		8
28	27	CCR-1237	BS 225/55R17 EP300 THI		1
29	28	CCR-1238	BS 225/55R17 T005A JAP		8
30	29	CCR-1239	BS 225/55R18 AL001 JAP		4
31	30	CCR-1240	BS 225/60R17 D-SPORT JAP	1	5
32	31	CCR-1241	BS 225/60R18 ALENZA001 JAP		4
33	32	CCR-1242	BS 225/70R15C R623 JAP		8
34	33	CCR-1243	BS 235/35ZR19 RE050A JAP		4
35	34	CCR-1244	BS 235/50R18 AL01 JAP		8
36	35	CCR-1245	BS 235/55R17 ER300 JAP		8
37	36	CCR-1246	BS 235/65R16C R660 TURK		12
38	37	CCR-1247	BS 245/40R18PR 050A JAP		8
39	38	CCR-1248	BS 245/40R19 T005 JAP		4
40	39	CCR-1249	BS 245/40ZR20 PSPORT JAP		4
41	40	CCR-1250	BS 245/45R17 T05A JAP		4
42	41	CCR-1251	BS 245/45R18 EP300 THI		4
43	42	CCR-1252	BS 245/45R19 T005A JAP		4
44	43	CCR-1253	BS 245/70R17 684A JAP		2
45	44	CCR-1254	BS 255/35R19 S001 JAP		4
46	45	CCR-1255	BS 255/50R20 AL001 JAP		8
47	46	CCR-1256	BS 255/70R15C D840 THI		33
48	47	CCR-1257	BS 265/55R20 D693 LCRUSER JAP		4
49	48	CCR-1158	BS 265/60R18 D840 JAP		4
50	49	CCR-1159	BS 265/65R17 D840 JAP		4
51	50	CCR-1160	BS 265/65R18 D693 JAP		4
52	51	CCR-1161	BS 265/70R16 D840 THI		76
53	52	CCR-1162	BS 275/35R21 RE21 JAP		4
54	53	CCR-1163	BS 275/65R18 AL01 JAP		12
55	54	CCR-1164	BS 285/60R18 DHPS JAP		8
56	55	CCR-1165	BS 285/65R17 R683 JAP		8
57	56	CCR-1166	BS 295/35R20 S001 JAP		4
58	57	CCR-1167	BS 315/80R22.5-18PR G580 JAP		12
59	58	CCR-1168	BS 315/80R22.5-18PR G582 THI		12
60	59	CCR-1169	BS 325/95 R24 M840 JAP		62
61	60	CCR-1170	BS 385/65 R22.5 R164 JAP		4
62	61	CCR-1171	BS 445/65R22.5 R164 JAP		24
63	62	CCR-1172	BS 650R16 R230 JAP		8
64	63	CCR-1173	BS 385/65 R22.5 R164 JAP		16
65	64	CCR-1174	BS 445/65R22.5 R164 JAP		18
66	65	CCR-1175	BS 650R16 R230 JAP		20
REPORT

examples:
pic: select cells A15,A19,A23

View attachment 87306
to become like this

Elmarghanie Brand .xlsm
	A	B	C	D	E
1	ITEM	CODE	BRAND	PURCHASE	SELLING
2	1	CCR-1216	BS 195/75R16C R613 JAP		6
3	2	CCR-1228	BS 205/60R16 T005 THI		8
4	3	CCR-1232	BS 215/55R17 T005 JAP		4
5	4	CCR-1220	BS 1200 R20 18PR G580 THI		20
6	5	CCR-1221	BS 1200 R20 18PR G580 JAP	30	471
7	6	CCR-1222	BS 1200R20-18PR R187 JAP		9
8	7	CCR-1223	BS 1200R24 G580	50	8
9	8	CCR-1224	BS 1200R24 G582	2
10	9	CCR-1225	BS 13 R22.5 R187 JAP		4
11	10	CCR-1226	BS 1400R20 TCF R180 JAP		2
12	11	CCR-1227	BS 1400R20 TCF R180BZ JAP		4
13	12	CCR-1211	BS 1400R20VSJ TCF JAP	22	55
14	13	CCR-1212	BS 165 R13C R624 IND	4	4
15	14	CCR-1213	BS 175/70R13 EP150 THI		2
16	15	CCR-1214	BS 185/65R15 B250 JAP		2
17	16	CCR-1215	BS 185/65R15 T001 JAP		1
18	17	CCR-1217	BS 195R14C 613 JAP		4
19	18	CCR-1218	BS 195R14C R623 THI		4
20	19	CCR-1219	BS 195R15C 613V JAP	4	4
21	20	CCR-1229	BS 205/70R15C R623 THI	8	405
22	21	CCR-1230	BS 205R16C D840 THI		26
23	22	CCR-1231	BS 215/50 R17 EP300 THI		10
24	23	CCR-1233	BS 215/60R16 ER30 JAP	8	8
25	24	CCR-1234	BS 215/65R15 T005A IND	4	4
EXAMPLE1

pic2 to select A5,A13,A21

View attachment 87307
to become to data have already sorted bottom

Elmarghanie Brand .xlsm
	A	B	C	D	E
1	ITEM	CODE	BRAND	PURCHASE	SELLING
2	1	CCR-1216	BS 195/75R16C R613 JAP		6
3	2	CCR-1228	BS 205/60R16 T005 THI		8
4	3	CCR-1232	BS 215/55R17 T005 JAP		4
5	4	CCR-1223	BS 1200R24 G580	50	8
6	5	CCR-1214	BS 185/65R15 B250 JAP		2
7	6	CCR-1230	BS 205R16C D840 THI		26
8	7	CCR-1220	BS 1200 R20 18PR G580 THI		20
9	8	CCR-1221	BS 1200 R20 18PR G580 JAP	30	471
10	9	CCR-1222	BS 1200R20-18PR R187 JAP		9
11	10	CCR-1224	BS 1200R24 G582	2
12	11	CCR-1225	BS 13 R22.5 R187 JAP		4
13	12	CCR-1226	BS 1400R20 TCF R180 JAP		2
14	13	CCR-1227	BS 1400R20 TCF R180BZ JAP		4
15	14	CCR-1211	BS 1400R20VSJ TCF JAP	22	55
16	15	CCR-1212	BS 165 R13C R624 IND	4	4
17	16	CCR-1213	BS 175/70R13 EP150 THI		2
18	17	CCR-1215	BS 185/65R15 T001 JAP		1
19	18	CCR-1217	BS 195R14C 613 JAP		4
20	19	CCR-1218	BS 195R14C R623 THI		4
21	20	CCR-1219	BS 195R15C 613V JAP	4	4
22	21	CCR-1229	BS 205/70R15C R623 THI	8	405
23	22	CCR-1231	BS 215/50 R17 EP300 THI		10
24	23	CCR-1233	BS 215/60R16 ER30 JAP	8	8
EXAMPLE2

pic3:
select cells A3,A25,A19,A13 to become like this

View attachment 87308

Elmarghanie Brand .xlsm
	A	B	C	D	E
1	ITEM	CODE	BRAND	PURCHASE	SELLING
2	1	CCR-1216	BS 195/75R16C R613 JAP		6
3	2	CCR-1232	BS 215/55R17 T005 JAP		4
4	3	CCR-1223	BS 1200R24 G580	50	8
5	4	CCR-1221	BS 1200 R20 18PR G580 JAP	30	471
6	5	CCR-1234	BS 215/65R15 T005A IND	4	4
7	6	CCR-1228	BS 205/60R16 T005 THI		8
8	7	CCR-1214	BS 185/65R15 B250 JAP		2
9	8	CCR-1230	BS 205R16C D840 THI		26
10	9	CCR-1220	BS 1200 R20 18PR G580 THI		20
11	10	CCR-1222	BS 1200R20-18PR R187 JAP		9
12	11	CCR-1224	BS 1200R24 G582	2
13	12	CCR-1225	BS 13 R22.5 R187 JAP		4
14	13	CCR-1226	BS 1400R20 TCF R180 JAP		2
15	14	CCR-1227	BS 1400R20 TCF R180BZ JAP		4
16	15	CCR-1211	BS 1400R20VSJ TCF JAP	22	55
17	16	CCR-1212	BS 165 R13C R624 IND	4	4
18	17	CCR-1213	BS 175/70R13 EP150 THI		2
19	18	CCR-1215	BS 185/65R15 T001 JAP		1
20	19	CCR-1217	BS 195R14C 613 JAP		4
21	20	CCR-1218	BS 195R14C R623 THI		4
22	21	CCR-1219	BS 195R15C 613V JAP	4	4
23	22	CCR-1229	BS 205/70R15C R623 THI	8	405
24	23	CCR-1231	BS 215/50 R17 EP300 THI		10
25	24	CCR-1233	BS 215/60R16 ER30 JAP	8	8
EXAMPLE3

so how sort these data again:
1-should arrange based on selected multiple cells in column who first, second, third ....... then arrange the whole multiple ranges

2- if I select different data then will arrange directly to data have already sorted (under data as in point1) bottom

3- if I select data have already sorted before then will arrange again and delete from old location and rise data have already existed to up

 

[abdo meghari]

if you see sorting selection sequence. ok it's not problem for me .

 

[Legacy 143009]

I think I've managed. Bind your button to mySort() function:

Dim mySelection() As Long
Dim counter As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Columns.Count = 1 And Not Intersect(Target, Columns(1)) Is Nothing And Intersect(Target, Range("A1")) Is Nothing Then
    ReDim Preserve mySelection(1 To Target.Count)
    mySelection(Target.Count) = Range(Split(Target.Address, ",")(Target.Count - 1)).Value
  End If
End Sub
Sub mySort()
  For Each sel In mySelection
    Rows(Application.Match(sel, Range("A:A"), 0)).Cut
    Rows(counter + 1).Offset(1).Insert
    counter = counter + 1
  Next
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Cells(i + 1, 1).Value = i
  Next
End Sub

 

[abdo meghari]

thanks
it gives error for loop not initialized in this line

For Each sel In mySelection

 

[Legacy 143009]

Yes, the code is not working when you select with dragging. I modified the code. I haven't encountered any problems but please let me know if you find a bug.

Sample.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Dim mySelection() As Long, counter As Long, i As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Columns.Count = 1 And Not Intersect(Target, Columns(1)) Is Nothing And Intersect(Target, Range("A1")) Is Nothing Then
    Application.EnableEvents = False
    Dim tmp1 As String, tmp2 As String, k As Long, j As Long
    ReDim Preserve mySelection(1 To Target.Count)
    k = 1
    For i = 0 To UBound(Split(Target.Address, ","))
      tmp1 = Split(Target.Address, ",")(i)
      For j = 0 To UBound(Split(tmp1, ":"))
        tmp2 = Split(tmp1, ":")(j)
        mySelection(k) = CLng(Range(tmp2).Value)
        k = k + 1
      Next
    Next
    Application.EnableEvents = True
  End If
End Sub
Sub mySort()
  Application.ScreenUpdating = False
  For Each sel In mySelection
    Rows(Application.Match(sel, Range("A:A"), 0)).Cut
    Rows(counter + 1).Offset(1).Insert
    counter = counter + 1
  Next
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 1
    Cells(i + 1, 1).Value = i
  Next
  Cells(counter, 1).Select
  Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

thanks again !
do you realize theses

the selection of a cell or several cells at the same time

and title of thread ?

selection multiple cells at once​

unfortunately when select multiple cells at once will show the same error

I modified the code. I haven't encountered any problems

really confused !

 

[Legacy 143009]

Selected multiple cells (2,4,5):

Run the code:

Sorted:

Sorry that I can help you no further.

 

[Legacy 143009]

Application.EnableEvents may left False. First run this piece of code. Close and open the file again and try again:

Sub test()
  Application.EnableEvents = True
End Sub

Using Application.EnableEvents is safe but you may remıbe these lines from the code if they are going to be problematic for you.

 

[abdo meghari]

as you see the picture select (A22,A5)

 

[Legacy 143009]

Application.EnableEvents may left False. First run this piece of code. Close and open the file again and try again:

Sub test()
  Application.EnableEvents = True
End Sub

Using Application.EnableEvents is safe but you may remıbe these lines from the code if they are going to be problematic for you.

Have you tried this?

Next time try to use the code like this:

Dim mySelection() As Long, counter As Long, i As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Columns.Count = 1 And Not Intersect(Target, Columns(1)) Is Nothing And Intersect(Target, Range("A1")) Is Nothing Then
    'Application.EnableEvents = False
    Dim tmp1 As String, tmp2 As String, k As Long, j As Long
    ReDim Preserve mySelection(1 To Target.Count)
    k = 1
    For i = 0 To UBound(Split(Target.Address, ","))
      tmp1 = Split(Target.Address, ",")(i)
      For j = 0 To UBound(Split(tmp1, ":"))
        tmp2 = Split(tmp1, ":")(j)
        mySelection(k) = CLng(Range(tmp2).Value)
        k = k + 1
      Next
    Next
    'Application.EnableEvents = True
  End If
End Sub
Sub mySort()
  Application.ScreenUpdating = False
  For Each sel In mySelection
    Rows(Application.Match(sel, Range("A:A"), 0)).Cut
    Rows(counter + 1).Offset(1).Insert
    counter = counter + 1
  Next
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 1
    Cells(i + 1, 1).Value = i
  Next
  Cells(counter, 1).Select
  Application.ScreenUpdating = True
End Sub

I don't know why you are having this error. The code works perfectly fine in my test file. It is impossible for me to troubleshoot your problem.

 

[abdo meghari]

ok your last version works perfectly as you said in your attaching , but unfortunately doesn't work my real file .
much appreciated if you're capable to see what's the problem for my real file .
Elmarghanie Brand .xlsm