Macro to sort (first by cell color and then by time in hours)

Meich

New Member
Joined
Jul 2, 2018
Messages
2
Hello! I have a problem with an excel sheet for work. Hope you can help!


I have to order employees by their entry time to work, and also by their role inside the company.

So, for example:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Colum A[/TD]
[TD]Colum B[/TD]
[TD]Colum C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Matt (regular employee)
[/TD]
[TD]07:00[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Philip (supervisor)[/TD]
[TD]07:00[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Oscar (supervisor)[/TD]
[TD]08:00[/TD]
[TD]16:00[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Jennifer (regular employee)[/TD]
[TD]09:00[/TD]
[TD]17:00[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Ben (duty manager)[/TD]
[TD]08:00[/TD]
[TD]16:00
[/TD]
[/TR]
</tbody>[/TABLE]


The role order is: Duty manager > Supervisor > Regular employee

So for this purpose I have use conditionals cell colors: Duty manager is RED, Supervisor is Green, Regular employee is Blue.

This way I can sort first colum A by color (RED>GREEN>BLUE), and then sort by entry time. The result would be:


[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Colum A[/TD]
[TD]Colum B[/TD]
[TD]Colum C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Ben (duty manager)[/TD]
[TD]08:00[/TD]
[TD]16:00[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Philip (supervisor)[/TD]
[TD]07:00[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Oscar (supervisor)[/TD]
[TD]08:00[/TD]
[TD]16:00[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Matt (regular employee)[/TD]
[TD]07:00[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Jennifer (regular employee)[/TD]
[TD]09:00[/TD]
[TD]17:00[/TD]
[/TR]
</tbody>[/TABLE]


I can do this easily with the regular sort and filter button. But I have to do it for all the days of the month, one at a time, for too many employees, and I lose so many time doing this.

I had try creating a macro for this, but it is driving me crazy. Please could you help me??? :rolleyes:


PD: Sorry for my english, hope you understand everything.
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Try this:-
NB:- This code works on employee "Title" not colour, and uses column "D" as a Helper Column.
NB:- The code assumes your data for the specific day starts in "A2" and does not cater for all the other days of the Month!!
Code:
[COLOR="Navy"]Sub[/COLOR] MG02Jul02
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] True
        [COLOR="Navy"]Case[/COLOR] InStr(Dn.Value, "(duty manager)") > 0: Dn.Offset(, 3) = 1
        [COLOR="Navy"]Case[/COLOR] InStr(Dn.Value, "(supervisor)") > 0: Dn.Offset(, 3) = 2
        [COLOR="Navy"]Case[/COLOR] InStr(Dn.Value, "(regular employee)") > 0: Dn.Offset(, 3) = 3
    [COLOR="Navy"]End[/COLOR] Select
[COLOR="Navy"]Next[/COLOR] Dn
Rng.Resize(, 4).Sort Key1:=Range("D1"), Order1:=xlAscending
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, 3)
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    .Item(K).Offset(, -3).Resize(, 4).Sort Key1:=.Item(K)(1).Offset(, -2), Order1:=xlAscending
[COLOR="Navy"]Next[/COLOR] K
Columns("D:D").ClearContents
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank you very much MickG! It helped me a lot, I just made a few changes and it works perfectly!
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,272
Members
452,628
Latest member
dd2

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