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

[Meich]

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:

	Colum A	Colum B	Colum C
1	Matt (regular employee)	07:00	15:00
2	Philip (supervisor)	07:00	15:00
3	Oscar (supervisor)	08:00	16:00
4	Jennifer (regular employee)	09:00	17:00
5	Ben (duty manager)	08:00	16:00

<tbody>
</tbody>

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:

	Colum A	Colum B	Colum C
1	Ben (duty manager)	08:00	16:00
2	Philip (supervisor)	07:00	15:00
3	Oscar (supervisor)	08:00	16:00
4	Matt (regular employee)	07:00	15:00
5	Jennifer (regular employee)	09:00	17:00

<tbody>
</tbody>

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???


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

 

[MickG]

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!!

[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

 

[Meich]

Thank you very much MickG! It helped me a lot, I just made a few changes and it works perfectly!

 

[MickG]

You're welcome