# Sorting code

#### kbishop94

##### Active Member
Previous thanks goes to Fluff for figuring out the code I have posted below (about a year ago I did this.) The code works brilliantly, but i am looking to further 'drill down' on the criteria... here is how it currently works:

I have a spreadsheet as shown with columns containing the different fields which all start on row 18. The rows above 18 are a summary of the data which calculates and populates the cells when the workbook is opened.

My current code:

The one for the "customer" tally (summary for which is displayed in A7 through B16) grabs all the data in column G (the customer column) (these are all under the workbook open event) and temporarily copies the calculated data on another worksheet ("CUS-TOTALS") where it is stored, then part of it (the top 10 rows) is copied and pasted onto the summary section on the main worksheet ("Seatex Incident Log") as shown in the picture above.
Code:
``````[B][COLOR=#008000]' capture and tally the total of the CUSTOMER column (starting at G18) on the worksheet "Seatex Incident Log"[/COLOR][/B]

ActiveWorkbook.Worksheets("CUS-TOTALS").Cells.Clear

Dim Cl As Range
Dim i As Long, J As Long
Dim Ary, Temp1, Temp2

With CreateObject("scripting.dictionary")

For Each Cl In Worksheets("Seatex Incident Log").Range("G18", Worksheets("Seatex Incident Log").Range("G" & Rows.Count).End(xlUp))
If Not .exists(Cl.Value) Then
Else
.Item(Cl.Value) = .Item(Cl.Value) + 1
End If
Next Cl

ReDim Ary(0 To .Count - 1, 0 To 1)
For i = 0 To .Count - 1
Ary(i, 0) = .keys()(i)
Ary(i, 1) = .Items()(i)
Next i
End With

For i = LBound(Ary, 1) To UBound(Ary, 1) - 1
For J = i + 1 To UBound(Ary, 1)
If Ary(i, 1) < Ary(J, 1) Then
Temp1 = Ary(J, 0)
Temp2 = Ary(J, 1)
Ary(J, 0) = Ary(i, 0)
Ary(J, 1) = Ary(i, 1)
Ary(i, 0) = Temp1
Ary(i, 1) = Temp2
End If
Next J
Next i

[B][COLOR=#008000]' take the data that was tallied from above and paste it onto the worksheet: "CUS-TOTALS"[/COLOR][/B]
Worksheets("CUS-TOTALS").Range("D" & Rows.Count).End(xlUp).Offset(0).Resize(UBound(Ary) + 1, 2).Value = Ary``````

It takes the copied data and copies it to the worksheet "CUS-TOTALS" and sorts it so the customers that appear with the most frequency appears first, then the second most, and 3rd most.... and so on:

Then this code takes the top 10 customers (code also doesnt count duplicates) and copies and pastes them onto the main sheet ("Seatex Incident Log")

Code:
``````[B][COLOR=#008000]' THIS IS COPYING THE COLUMN THAT CONTAINS THE *NAMES* OF THE TOP CUSTOMERS FROM THE 1ST COLUMN DOWN TO THE 10TH, WHICH HAS ALREADY BEEN SORTED FROM HIGHEST TO LOWEST _[/COLOR][/B]
[COLOR=#008000][B]AND PASTING THE COPIED DATA ONTO THE SEATEX INCIDENT LOG SHEET IN THE APPROPRIATE PLACE.[/B][/COLOR]

Worksheets("CUS-TOTALS").Activate
Worksheets("CUS-TOTALS").Range("D2:D11").Select
Selection.copy
Sheets("Seatex Incident Log").Activate
Worksheets("Seatex Incident Log").Range("B7:B16").Select
Range("B7:B16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

[B][COLOR=#008000]' THIS IS COPYING THE COLUMN THAT CONTAINS THE *NUMBER* OF THE TOP CUSTOMERS FROM THE 1ST COLUMN DOWN TO THE 10TH, WHICH HAS ALREADY BEEN SORTED FROM HIGHEST TO LOWEST _[/COLOR][/B]
[COLOR=#008000][B]AND PASTING THE COPIED DATA ONTO THE SEATED INCIDENT LOG SHEET IN THE APPROPRIATE PLACE.[/B][/COLOR]

Worksheets("CUS-TOTALS").Activate
Worksheets("CUS-TOTALS").Range("E2:E11").Select
Selection.copy
Sheets("Seatex Incident Log").Activate
Worksheets("Seatex Incident Log").Range("A7:A16").Select
Range("A7:A16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False``````

So what I am wanting to do now is the same thing but only do it for the entries that are from the year 2018. (the code above just takes all teh customers in the entire column regardless of the year....

I have a column (hidden) that contains just the year in column AB (where the new code will have to use to narrow it down to a specific year):

Ultimately the 'new' data should look like this (after its tallied and pasted to a temp worksheet just like the code above does):
Column 'C' i left in so you can see what the tally is for each customer (sorted with the ones with highest amount first) for the year 2018.

Please and Thank You for any and all help on this one!

Last edited:

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

#### kbishop94

##### Active Member
Re: need help with this sorting code...

Anyone?

#### Fluff

##### MrExcel MVP, Moderator
Re: need help with this sorting code...

Try making this change
Code:
``````For Each Cl In Worksheets("Seatex Incident Log").Range("G18", Worksheets("Seatex Incident Log").Range("G" & Rows.Count).End(xlUp))
If Not .Exists(Cl.Value) [COLOR=#ff0000]And Cl.Offset(, 21) = 2018 [/COLOR]Then
Else
.Item(Cl.Value) = .Item(Cl.Value) + 1
End If
Next Cl``````

#### kbishop94

##### Active Member
Re: need help with this sorting code...

Try making this change
Code:
``````For Each Cl In Worksheets("Seatex Incident Log").Range("G18", Worksheets("Seatex Incident Log").Range("G" & Rows.Count).End(xlUp))
If Not .Exists(Cl.Value) [COLOR=#ff0000]And Cl.Offset(, 21) = 2018 [/COLOR]Then
Else
.Item(Cl.Value) = .Item(Cl.Value) + 1
End If
Next Cl``````

Hmmm... well, it didnt change anything.

I believe your ', 21' offset is 21 columns over from the customer field in G (7) to get to the column where the year is... which is AB (?)
I thought it might be a formatting issue where it is looking for all the "2018" 's in column AB, so I also formatted the cells in AB to 'general' (so it appears just as '2018' and not a complete date that appears as 2018 in the cell.) But, that also didnt change anything either.

Here is what the new code presents on the CUS-TOTALS sheet (which is the same as it is without it )

Please & thank you for anything else to try(?)

Last edited:

#### Fluff

##### MrExcel MVP, Moderator

Re: need help with this sorting code...

If you have a date rather than just the year try
Code:
``And year(Cl.Offset(, 21).value) = 2018``

#### kbishop94

##### Active Member
Re: need help with this sorting code...

If you have a date rather than just the year try
Code:
``And year(Cl.Offset(, 21).value) = 2018``

Tried that, and several different ways (like with and without quotes and tried it with different years and such as well... no luck.)

Just to make sure its not a formatting issue, here is how i have it formatted. Also shown is the other column I inserted " (, 22) " and have that just formatted as "General"

Thank you for all your help.

#### kbishop94

##### Active Member

Re: need help with this sorting code...

Here is the code again so you can see exactly what I am working with.. . & updated with the "year" part:

Code:
``````[B][COLOR=#008000]' capture and tally the total of the CUSTOMER column (starting at G18) on the worksheet "Seatex Incident Log"[/COLOR][/B]

ActiveWorkbook.Worksheets("2018-CUS-TOTALS").Cells.Clear

Dim Cl As Range
Dim i As Long, J As Long
Dim Ary, Temp1, Temp2

With CreateObject("scripting.dictionary")

For Each Cl In Worksheets("Seatex Incident Log").Range("G18", Worksheets("Seatex Incident Log").Range("G" & Rows.Count).End(xlUp))
If Not .Exists(Cl.Value) And Year(Cl.Offset(, 21).Value) = 2018 Then
Else
.Item(Cl.Value) = .Item(Cl.Value) + 1
End If
Next Cl

ReDim Ary(0 To .Count - 1, 0 To 1)
For i = 0 To .Count - 1
Ary(i, 0) = .keys()(i)
Ary(i, 1) = .Items()(i)
Next i
End With

For i = LBound(Ary, 1) To UBound(Ary, 1) - 1
For J = i + 1 To UBound(Ary, 1)
If Ary(i, 1) < Ary(J, 1) Then
Temp1 = Ary(J, 0)
Temp2 = Ary(J, 1)
Ary(J, 0) = Ary(i, 0)
Ary(J, 1) = Ary(i, 1)
Ary(i, 0) = Temp1
Ary(i, 1) = Temp2
End If
Next J
Next i

[B][COLOR=#008000]' take the data that was tallied from above and paste it onto the worksheet: "CUS-TOTALS"[/COLOR][/B]

Worksheets("2018-CUS-TOTALS").Range("D" & Rows.Count).End(xlUp).Offset(0).Resize(UBound(Ary) + 1, 2).Value = Ary``````

Last edited:

#### Fluff

##### MrExcel MVP, Moderator
Re: need help with this sorting code...

Code:
``````   For Each Cl In Worksheets("Seatex Incident Log").Range("G18", Worksheets("Seatex Incident Log").Range("G" & Rows.Count).End(xlUp))
If Year(Cl.Offset(, 21).Value) = 2018 Then
If Not .Exists(Cl.Value) Then
Else
.Item(Cl.Value) = .Item(Cl.Value) + 1
End If
End If
Next Cl``````

#### kbishop94

##### Active Member
Re: need help with this sorting code...

That was the one!!

Thank you so much

#### Fluff

##### MrExcel MVP, Moderator
Re: need help with this sorting code...

You're welcome & thanks for the feedback

Replies
12
Views
89
Replies
13
Views
105
Replies
7
Views
391
Replies
2
Views
352
Replies
1
Views
278