Sorting code

kbishop94

Active Member
Joined
Dec 5, 2016
Messages
301
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.

Spreadsheet:


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
         .Add Cl.Value, 1
      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:

Some videos you may like

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,421
Office Version
  1. 365
Platform
  1. Windows
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
         .Add Cl.Value, 1
      Else
         .Item(Cl.Value) = .Item(Cl.Value) + 1
      End If
   Next Cl
 

kbishop94

Active Member
Joined
Dec 5, 2016
Messages
301
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
         .Add Cl.Value, 1
      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. :confused:

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
Joined
Jun 12, 2014
Messages
46,421
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
Joined
Dec 5, 2016
Messages
301
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
Joined
Dec 5, 2016
Messages
301

ADVERTISEMENT

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
         .Add Cl.Value, 1
      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
Joined
Jun 12, 2014
Messages
46,421
Office Version
  1. 365
Platform
  1. Windows
Re: need help with this sorting code...

How about
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
            .Add Cl.Value, 1
         Else
            .Item(Cl.Value) = .Item(Cl.Value) + 1
         End If
      End If
   Next Cl
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,421
Office Version
  1. 365
Platform
  1. Windows
Re: need help with this sorting code...

You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,157
Messages
5,527,128
Members
409,749
Latest member
esmarques

This Week's Hot Topics

Top