Excel VBA to arrange duty table

[nickyl82]

Hello, guys,

I need to select two people from a list of 50 for them to be on duty on that day, and make a table. The code should generate the arrangement for a month, from the first day to the last, which means that it must decide how many working days in current month.

In the table, Column A would be the date, column B and C would be the names of the selected people. Column F contains the list of all the people(from F2 to F51), which is there already. The rule is that no one would be on duty for two days in a row (a Friday and the Monday after that also counts as two consecutive days).

I could do this manually as there are only 50 people, but if I do it with VBA, then nobody is gonna question my impartiality.

It appears easy, but I can't figure it out. Fancy the Challenge? Thanks a lot guys!!

 

[MickG]

Try this:-
Assumed Column "A" Dates start row (2).

[COLOR="Navy"]Sub[/COLOR] MG23Apr08
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] RngNam [COLOR="Navy"]As[/COLOR] Range, n
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] RngNam = Range(Range("F2"), Range("F" & rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
'[COLOR="Green"][B]This line places weekdays in column "C"[/B][/COLOR]
'[COLOR="Green"][B]Remove as required[/B][/COLOR]
Dn.Offset(, 3) = WeekdayName(Weekday(Dn, vbMonday))
[COLOR="Navy"]If[/COLOR] Weekday(Dn, vbMonday) <> 6 And Weekday(Dn, vbMonday) <> 7 [COLOR="Navy"]Then[/COLOR]
    n = n + 1
    n = IIf(n = 51, 1, n)
    Dn.Offset(, 1) = RngNam(n)
    n = n + 1
    n = IIf(n = 51, 1, n)
    Dn.Offset(, 2) = RngNam(n)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick