Special Sort, Sort Groups.

H

harzer

Board Regular
Joined
Dec 15, 2021
Messages
122
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone,
I submit to you my request for coding in vba that I do not know how to solve.
My project has two sheets, the "Issues" sheet = source sheet, then the "Groups" sheet = destination sheet. In my source sheet "Issus" there are 12 columns and a number of rows in length that changes every week.
The source sheet, groups several data which are separated by empty lines. I put each group with a different color to differentiate them.
The number of lines of each group is variable, this number is indicated in the last line of each group in column "L".
Here is an overview of the "Issues" sheet

ListeSansDoublonsDict.xls
ABCDEFGHIJKL
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevageNombre
2AE27-092/2013 FCF03-156/2011 MYM856-131/2011 FGérard Claude10a 0m 0j5H1404-06-135TMâle
3AE27-093/2013 FCF03-156/2011 MYM856-131/2011 FGérard Claude10a 0m 0j5H1404-06-135TMâle
4AE27-001/2019 MPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H1219-04-195TFemelle
5AE27-002/2019 mPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H1219-04-195TFemelle
6AE27-003/2019 mPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H1320-04-195TFemelle 5
7
8AE27-011/2019 FPG14-003/2018 MAE27-003/2018 FGérard Claude4a 1m 14j4H1122-04-195TFemelle Tte jaune1
9
10AE27-013/2019 MPG14-048/2016 MAE27-008/2018 FGérard Claude4a 1m 14j4H122-04-194TMâle Tt jaune
11AE27-014/2019 FAE27-029/2017 MPG14-048/2018 FGérard Claude4a 1m 16j4H220-04-194TFemelle Tte jaune
12AE27-015/2019 MAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j4H619-04-194TMâle 3
13
14AE27-017/2019 FAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j3H619-04-194TFemelle Tt jaune - Ptes Flûtes - cris d'appel!
15AE27-018/2019 MAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j4H619-04-194TMâle
16AE27-019/2019 MAE27-034/2017 MAE27-034/2018 FGérard Claude4a 1m 16j4H820-04-194TMâle Tâche tête
17AE27-020/2019 MAE27-034/2017 MAE27-034/2018 FGérard Claude4a 1m 16j4H820-04-194TMâle Tâche derrière œil et tête - Klingelrol
18AE27-035/2022 MMN96-005/2021 MAE27-068/2021 FGérard Claude0a 11m 23j5H413-06-224TMâle Tt jaunex
19AE27-036/2022 MMN96-005/2021 MAE27-068/2021 FGérard Claude0a 11m 23j5H413-06-224TMâle Tt Jaune6
20
21AE27-045/2022 MAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j5H825-06-224TMâle Tâche aile droite (n'aime pas être pris en main)
22AE27-046/2022 MAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j5H825-06-224TMâle Tte jaune
23AE27-047/2022 FAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j4H825-06-224TFemelle Tte jaune
24AE27-048/2022 FAE27-006/2021 MAE27-052/2021 FGérard Claude0a 11m 8j4H328-06-224TFemelle Tâche aux 2 ailes4
25
26AE27-001/2023 MAE27-008/2022 MAE27-039/2022 FGérard Claude0a 1m 11j5H1525-04-234TMâle Tache au dos - Mange seul à 26 jours1
27
28AE27-003/2023 FAE27-032/2022 MAE27-026/2022 FGérard Claude0a 0m 31j5H1205-05-234TFemelle tâche tête
29AE27-004/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle Tâche tête
30AE27-005/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle 3
31
32AE27-007/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle
33AE27-008/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle
34AE27-009/2023 MAE27-022/2022 MMN96-010/2020 FGérard Claude0a 0m 14j5H622-05-234TMâle
35AE27-010/2023 FAE27-022/2022 MMN96-010/2020 FGérard Claude0a 0m 14j5H622-05-234TMâle 4
36
37AE27-014/2023 MAE27-029/2022 M207-034/2022 FGérard Claude0a 0m 13j5H1323-05-234TMâle
38AE27-018/2023 MAE27-33/2022 MAE27-024/2022 FGérard Claude0a 0m 11j5H725-05-234TMâle 2
Issus


What I want to do is sort all of these groups by the number of rows shown in the "L" column.
Unless I'm mistaken, here is the result I need to find in the "Groups" sheet.

ListeSansDoublonsDict.xls
ABCDEFGHIJKL
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevageNombre
2AE27-017/2019 FAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j3H619-04-194TFemelle Tt jaune - Ptes Flûtes - cris d'appel!
3AE27-018/2019 MAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j4H619-04-194TMâle
4AE27-019/2019 MAE27-034/2017 MAE27-034/2018 FGérard Claude4a 1m 16j4H820-04-194TMâle Tâche tête
5AE27-020/2019 MAE27-034/2017 MAE27-034/2018 FGérard Claude4a 1m 16j4H820-04-194TMâle Tâche derrière œil et tête - Klingelrol
6AE27-035/2022 MMN96-005/2021 MAE27-068/2021 FGérard Claude0a 11m 23j5H413-06-224TMâle Tt jaunex
7AE27-036/2022 MMN96-005/2021 MAE27-068/2021 FGérard Claude0a 11m 23j5H413-06-224TMâle Tt Jaune6
8
9AE27-092/2013 FCF03-156/2011 MYM856-131/2011 FGérard Claude10a 0m 0j5H1404-06-135TMâle
10AE27-093/2013 FCF03-156/2011 MYM856-131/2011 FGérard Claude10a 0m 0j5H1404-06-135TMâle
11AE27-001/2019 MPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H1219-04-195TFemelle
12AE27-002/2019 mPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H1219-04-195TFemelle
13AE27-003/2019 mPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H1320-04-195TFemelle 5
14
15AE27-045/2022 MAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j5H825-06-224TMâle Tâche aile droite (n'aime pas être pris en main)
16AE27-046/2022 MAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j5H825-06-224TMâle Tte jaune
17AE27-047/2022 FAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j4H825-06-224TFemelle Tte jaune
18AE27-048/2022 FAE27-006/2021 MAE27-052/2021 FGérard Claude0a 11m 8j4H328-06-224TFemelle Tâche aux 2 ailes4
19
20AE27-007/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle
21AE27-008/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle
22AE27-009/2023 MAE27-022/2022 MMN96-010/2020 FGérard Claude0a 0m 14j5H622-05-234TMâle
23AE27-010/2023 FAE27-022/2022 MMN96-010/2020 FGérard Claude0a 0m 14j5H622-05-234TMâle 4
24
25AE27-013/2019 MPG14-048/2016 MAE27-008/2018 FGérard Claude4a 1m 14j4H122-04-194TMâle Tt jaune
26AE27-014/2019 FAE27-029/2017 MPG14-048/2018 FGérard Claude4a 1m 16j4H220-04-194TFemelle Tte jaune
27AE27-015/2019 MAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j4H619-04-194TMâle 3
28
29AE27-003/2023 FAE27-032/2022 MAE27-026/2022 FGérard Claude0a 0m 31j5H1205-05-234TFemelle tâche tête
30AE27-004/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle Tâche tête
31AE27-005/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H521-05-234TMâle 3
32
33AE27-014/2023 MAE27-029/2022 M207-034/2022 FGérard Claude0a 0m 13j5H1323-05-234TMâle
34AE27-018/2023 MAE27-33/2022 MAE27-024/2022 FGérard Claude0a 0m 11j5H725-05-234TMâle 2
35
36AE27-011/2019 FPG14-003/2018 MAE27-003/2018 FGérard Claude4a 1m 14j4H1122-04-195TFemelle Tte jaune1
37
38AE27-001/2023 MAE27-008/2022 MAE27-039/2022 FGérard Claude0a 1m 11j5H1525-04-234TMâle Tache au dos - Mange seul à 26 jours1
Groupes


I remain at your disposal for further information.
N.B.: given the large amount of data to be processed, I would like to ask you for a code that could process the data fairly quickly.
Thanks for your suggestions.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
Try this on your copy of the workbook:
I'm using col N:O as a helper column, you can remove it after running the code.
If the results are somehow messed up then you can sort the data by column O to get back to the original order.
About how many rows is your actual data?
VBA Code: 
Sub harzer_1()
Dim i As Long, n As Long, x As Long
Dim va, vb, vc
Dim d As Object
Dim t As Double
t = Timer
Rows(2).Insert
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A1:A" & n)
vb = Range("L1:L" & n)
ReDim vc(1 To UBound(va, 1), 1 To 2)
Set d = CreateObject("scripting.dictionary")

For i = UBound(va, 1) To 2 Step -1
        If vb(i, 1) <> "" Then
            x = vb(i, 1)
            d(x) = d(x) + 1
            x = vb(i, 1) * 100000 + d.Item(x)
        End If

    vc(i, 1) = x

Next

vc(1, 1) = 1
For i = 1 To UBound(vc, 1)
    vc(i, 2) = i
Next
vc(2, 2) = ""

Range("N:O").Clear
Range("N1").Resize(UBound(vc, 1), 2) = vc

Range("A:O").Sort Key1:=Range("N1"), Order1:=xlDescending, Header:=xlYes
Rows(2).Delete
Debug.Print "It's done in:  " & Format(Timer - t, "0.0000") & " seconds"

End Sub

Result:
Book1
ABCDEFGHIJKLMNO
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevageNombre11
2AE27-017/2019 FAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j3H6435744TFemelle Tt jaune - Ptes Flûtes - cris d'appel!60000115
3AE27-018/2019 MAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j4H6435744TMâle 60000116
4AE27-019/2019 MAE27-034/2017 MAE27-034/2018 FGérard Claude4a 1m 16j4H8435754TMâle Tâche tête60000117
5AE27-020/2019 MAE27-034/2017 MAE27-034/2018 FGérard Claude4a 1m 16j4H8435754TMâle Tâche derrière œil et tête - Klingelrol60000118
6AE27-035/2022 MMN96-005/2021 MAE27-068/2021 FGérard Claude0a 11m 23j5H4447254TMâle Tt jaunex60000119
7AE27-036/2022 MMN96-005/2021 MAE27-068/2021 FGérard Claude0a 11m 23j5H4447254TMâle Tt Jaune660000120
8500001
9AE27-092/2013 FCF03-156/2011 MYM856-131/2011 FGérard Claude10a 0m 0j5H14414295TMâle 5000013
10AE27-093/2013 FCF03-156/2011 MYM856-131/2011 FGérard Claude10a 0m 0j5H14414295TMâle 5000014
11AE27-001/2019 MPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H12435745TFemelle5000015
12AE27-002/2019 mPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H12435745TFemelle 5000016
13AE27-003/2019 mPG14-001/2016 MAE27-010/2018 FGérard Claude4a 1m 17j5H13435755TFemelle 55000017
1440000221
15AE27-045/2022 MAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j5H8447374TMâle Tâche aile droite (n'aime pas être pris en main)40000222
16AE27-046/2022 MAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j5H8447374TMâle Tte jaune40000223
17AE27-047/2022 FAE27-024/2021 MAE27-016+/2020 FGérard Claude0a 11m 11j4H8447374TFemelle Tte jaune40000224
18AE27-048/2022 FAE27-006/2021 MAE27-052/2021 FGérard Claude0a 11m 8j4H3447404TFemelle Tâche aux 2 ailes440000225
1940000132
20AE27-007/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H5450674TMâle 40000133
21AE27-008/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H5450674TMâle 40000134
22AE27-009/2023 MAE27-022/2022 MMN96-010/2020 FGérard Claude0a 0m 14j5H6450684TMâle 40000135
23AE27-010/2023 FAE27-022/2022 MMN96-010/2020 FGérard Claude0a 0m 14j5H6450684TMâle 440000136
2430000210
25AE27-013/2019 MPG14-048/2016 MAE27-008/2018 FGérard Claude4a 1m 14j4H1435774TMâle Tt jaune30000211
26AE27-014/2019 FAE27-029/2017 MPG14-048/2018 FGérard Claude4a 1m 16j4H2435754TFemelle Tte jaune30000212
27AE27-015/2019 MAE27-032/2017 MAE27-007/2018 FGérard Claude4a 1m 17j4H6435744TMâle 330000213
2830000128
29AE27-003/2023 FAE27-032/2022 MAE27-026/2022 FGérard Claude0a 0m 31j5H12450514TFemelle tâche tête30000129
30AE27-004/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H5450674TMâle Tâche tête30000130
31AE27-005/2023 MAE27-010/2021 MMN96-034/2021 FGérard Claude0a 0m 15j5H5450674TMâle 330000131
3220000137
33AE27-014/2023 MAE27-029/2022 M207-034/2022 FGérard Claude0a 0m 13j5H13450694TMâle 20000138
34AE27-018/2023 MAE27-33/2022 MAE27-024/2022 FGérard Claude0a 0m 11j5H7450714TMâle 220000139
351000028
36AE27-011/2019 FPG14-003/2018 MAE27-003/2018 FGérard Claude4a 1m 14j4H11435775TFemelle Tte jaune11000029
3710000126
38AE27-001/2023 MAE27-008/2022 MAE27-039/2022 FGérard Claude0a 1m 11j5H15450414TMâle Tache au dos - Mange seul à 26 jours110000127
Sheet3
 
Upvote 0
Sorry, the code in post #2 is flawed regarding "you can sort the data by column O to get back to the original order".
Try this one instead:
VBA Code: 
Sub harzer_2()
Dim i As Long, n As Long, x As Long
Dim va, vb, vc
Dim d As Object
Dim t As Double
t = Timer
Rows(2).Insert
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A1:A" & n)
vb = Range("L1:L" & n)
ReDim vc(1 To UBound(va, 1), 1 To 2)
Set d = CreateObject("scripting.dictionary")

For i = UBound(va, 1) To 2 Step -1
        If vb(i, 1) <> "" Then
            x = vb(i, 1)
            d(x) = d(x) + 1
            x = vb(i, 1) * 100000 + d.Item(x)
        End If
    vc(i, 1) = x
Next

    vc(1, 1) = 0
    For i = 1 To UBound(vc, 1)
        vc(i, 2) = i
    Next
    vc(2, 2) = 9000000

Range("N:O").Clear
Range("N1").Resize(UBound(vc, 1), 2) = vc

Range("A:O").Sort Key1:=Range("N1"), Order1:=xlDescending, Header:=xlYes
Range("O" & n + 1) = Range("O2")
Rows(2).Delete

Debug.Print "It's done in:  " & Format(Timer - t, "0.0000") & " seconds"

End Sub
 
Upvote 0
Hello Eakuini,

Thanks for your code.

I took the necessary time to do my tests and I can confirm that the results given by the code are correct.

In addition, the code is very fast. Thank you very much for your work.

However, I have two small questions for you:

1- In your message, you say: you can sort the data by column O to return to the original order: --> how to do?

2- To better understand your code, can you please comment it, this will allow me to see all the progress that the code makes to find this good solution.

Thank you again and looking forward to reading from you.

Good for you.
 
Upvote 0
Hello Eakuini,
I forgot to answer your question about the number of rows of my data: there are at least 6000 rows.
Good for you.
 
Upvote 0
harzer said:
2- To better understand your code, can you please comment it, this will allow me to see all the progress that the code makes to find this good solution.
Click to expand...

Sorry, it's hard for me to explain the code because of 2 reasons:
1. I'm not good at explaining things in English, my English is just basic.
2. The code is a bit complex to explain in writing.
basically the code does this:
It starts from the bottom of col F > if it finds a value, says 3 then it will produce a number i.e. x = 3 * 100000 + 1, in this line:
VBA Code: 
x = vb(i, 1) * 100000 + d.Item(x)
If later it finds 3 again then the number (x) will increase by 1, i.e x = 3 * 100000 + 2.
These numbers are loaded to variable vc then they are sent to col N (helper column) and then the data will be sorted descending by col N.

You can put a stop in this line:
Range("A:O").Sort Key1:=Range("N1"), Order1:=xlDescending, Header:=xlYes

run the code & see the sheet, you can see col N before it sorted.

harzer said:
1- In your message, you say: you can sort the data by column O to return to the original order: --> how to do?
Click to expand...

Select col A:O then sort by col O or you can use this code:
VBA Code: 
Sub get_back()
Range("A:O").Sort Key1:=Range("O1"), Order1:=xlAscending, Header:=xlYes

End Sub
 
Upvote 0
Hello Akuini,
Thank you for your reply.
Adding your comments helped me a lot to understand your code.
In addition, I also used the "F5" button when launching your macro to see (step by step) all the steps of the code.
Again, thank you for all the hard work.
Cheers.
 
Upvote 0
I'm glad it worked.
But I think I made the code unnecessary complex.
I wrote a simpler version, when the code finds a number in col L for example 3 then it just send 3 to variable vc instead of x = 3 * 100000 + 1. So basically just send the number in col L in a group to the N.
VBA Code: 
Sub harzer_3()
Dim i As Long, n As Long, x As Long
Dim va, vb, vc
Dim t As Double

t = Timer
Rows(2).Insert
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A1:A" & n)
vb = Range("L1:L" & n)
ReDim vc(1 To UBound(va, 1), 1 To 2)

For i = UBound(va, 1) To 2 Step -1
    If vb(i, 1) <> "" Then x = vb(i, 1)
    vc(i, 1) = x
Next

vc(1, 1) = 1
For i = 1 To UBound(vc, 1)
    vc(i, 2) = i
Next
vc(2, 2) = ""

Range("N:O").Clear
Range("N1").Resize(UBound(vc, 1), 2) = vc

Range("A:O").Sort Key1:=Range("N1"), Order1:=xlDescending, Header:=xlYes
Rows(2).Delete
Debug.Print "It's done in:  " & Format(Timer - t, "0.0000") & " seconds"

End Sub
 
Upvote 0
Solution
Hello Akuini
Thank you for this last version, it is as you say simple.
Often what is simple, is effective and works perfectly.
With this release, I think if I step through the code and follow all the steps, I might eventually comment it out, at least I hope so.
Thank you very much for this efficient and simplified version.
Best regards.
 
Upvote 0
You're welcome, glad to help & thanks for the feedback.:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Modify content of cells in column "F" according to the content of cells in column "A"
Replies
5
Views
342
igold
igold
H
  • Solved
Search for topics based on their groups.
Replies
7
Views
143
Peter_SSs
Peter_SSs
H
  • Solved
Count nonblank lines (between blank lines)
2
Replies
15
Views
695
Alex Blakenburg
A
H
  • Solved
Transpose data.
Replies
4
Views
117
harzer
H
H
  • Question
Insert the space character in the penultimate place of all the cells of columns "A" - "B" & "C".
Replies
3
Views
234
Fluff
Fluff

Forum statistics

Threads
1,215,108
Messages
6,123,132
Members
449,097
Latest member
mlckr

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top