-- I operate the 10 week rotating roster as shown below. I need to be able
to perform 2 separate tasks the first of which is to enter a start date of
the week and then as each new week starts the names drop down 1 line and the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to be able to
do is post each person their duties for the next 4 week cycle which would
automatically update when the new periods start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi

With your first set of days appearing in cells B4:H4, and the subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press Enter, the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need to be
able
to perform 2 separate tasks the first of which is to enter a start date of
the week and then as each new week starts the names drop down 1 line and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to be able
to
do is post each person their duties for the next 4 week cycle which would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi Roger
Thanks for your reply but there appears to be a snag in that although the
names move down a line each week so does the duty line move down as well so
that each person remains doing the same duties for each week. What needs to
happen is that either the names or the duties move down each week but not
both.
Thanks again for your help
--
Al


"Roger Govier" wrote:

Hi

With your first set of days appearing in cells B4:H4, and the subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press Enter, the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need to be
able
to perform 2 separate tasks the first of which is to enter a start date of
the week and then as each new week starts the names drop down 1 line and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to be able
to
do is post each person their duties for the next 4 week cycle which would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi Al

You know I realised that overnight, and had meant to post a revision this
morning, but completely forgot. Little point in moving both name and Roster.

The following amended code, still copies the main first block of roster
information down for the other three weeks (just in case you decide to amend
the roster itself), but the "shuffle, only takes place on column A for
Names.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


I hope this now resolves the problem.

--
Regards
Roger Govier



"gramps" wrote in message
...
Hi Roger
Thanks for your reply but there appears to be a snag in that although the
names move down a line each week so does the duty line move down as well
so
that each person remains doing the same duties for each week. What needs
to
happen is that either the names or the duties move down each week but not
both.
Thanks again for your help
--
Al


"Roger Govier" wrote:

Hi

With your first set of days appearing in cells B4:H4, and the subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press Enter,
the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need to be
able
to perform 2 separate tasks the first of which is to enter a start date
of
the week and then as each new week starts the names drop down 1 line
and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to be
able
to
do is post each person their duties for the next 4 week cycle which
would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi Roger
Thanks a million for that. It works a treat.
--
Al


"Roger Govier" wrote:

Hi Al

You know I realised that overnight, and had meant to post a revision this
morning, but completely forgot. Little point in moving both name and Roster.

The following amended code, still copies the main first block of roster
information down for the other three weeks (just in case you decide to amend
the roster itself), but the "shuffle, only takes place on column A for
Names.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


I hope this now resolves the problem.

--
Regards
Roger Govier



"gramps" wrote in message
...
Hi Roger
Thanks for your reply but there appears to be a snag in that although the
names move down a line each week so does the duty line move down as well
so
that each person remains doing the same duties for each week. What needs
to
happen is that either the names or the duties move down each week but not
both.
Thanks again for your help
--
Al


"Roger Govier" wrote:

Hi

With your first set of days appearing in cells B4:H4, and the subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press Enter,
the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need to be
able
to perform 2 separate tasks the first of which is to enter a start date
of
the week and then as each new week starts the names drop down 1 line
and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to be
able
to
do is post each person their duties for the next 4 week cycle which
would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi again Roger
As an afterthought what changes would I have to make to apply it to a 5 week
rota?
Thanks again
--
Al


"gramps" wrote:

Hi Roger
Thanks a million for that. It works a treat.
--
Al


"Roger Govier" wrote:

Hi Al

You know I realised that overnight, and had meant to post a revision this
morning, but completely forgot. Little point in moving both name and Roster.

The following amended code, still copies the main first block of roster
information down for the other three weeks (just in case you decide to amend
the roster itself), but the "shuffle, only takes place on column A for
Names.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


I hope this now resolves the problem.

--
Regards
Roger Govier



"gramps" wrote in message
...
Hi Roger
Thanks for your reply but there appears to be a snag in that although the
names move down a line each week so does the duty line move down as well
so
that each person remains doing the same duties for each week. What needs
to
happen is that either the names or the duties move down each week but not
both.
Thanks again for your help
--
Al


"Roger Govier" wrote:

Hi

With your first set of days appearing in cells B4:H4, and the subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press Enter,
the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need to be
able
to perform 2 separate tasks the first of which is to enter a start date
of
the week and then as each new week starts the names drop down 1 line
and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to be
able
to
do is post each person their duties for the next 4 week cycle which
would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi

Just change the size of the loop from 3 to 4
For i = 1 To 3

For i = 1 To 4



--
Regards
Roger Govier



"gramps" wrote in message
...
Hi again Roger
As an afterthought what changes would I have to make to apply it to a 5
week
rota?
Thanks again
--
Al


"gramps" wrote:

Hi Roger
Thanks a million for that. It works a treat.
--
Al


"Roger Govier" wrote:

Hi Al

You know I realised that overnight, and had meant to post a revision
this
morning, but completely forgot. Little point in moving both name and
Roster.

The following amended code, still copies the main first block of roster
information down for the other three weeks (just in case you decide to
amend
the roster itself), but the "shuffle, only takes place on column A for
Names.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


I hope this now resolves the problem.

--
Regards
Roger Govier



"gramps" wrote in message
...
Hi Roger
Thanks for your reply but there appears to be a snag in that although
the
names move down a line each week so does the duty line move down as
well
so
that each person remains doing the same duties for each week. What
needs
to
happen is that either the names or the duties move down each week but
not
both.
Thanks again for your help
--
Al


"Roger Govier" wrote:

Hi

With your first set of days appearing in cells B4:H4, and the
subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of
the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your
sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press
Enter,
the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need
to be
able
to perform 2 separate tasks the first of which is to enter a start
date
of
the week and then as each new week starts the names drop down 1
line
and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to
be
able
to
do is post each person their duties for the next 4 week cycle
which
would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi Roger
Sorry, I didn't explain what I meant properly. What I was wondering was what
changes to make if it was only a 5 man rota but to still show 4 weeks at a
time.
Thanks again
--
Al


"Roger Govier" wrote:

Hi

Just change the size of the loop from 3 to 4
For i = 1 To 3

For i = 1 To 4



--
Regards
Roger Govier



"gramps" wrote in message
...
Hi again Roger
As an afterthought what changes would I have to make to apply it to a 5
week
rota?
Thanks again
--
Al


"gramps" wrote:

Hi Roger
Thanks a million for that. It works a treat.
--
Al


"Roger Govier" wrote:

Hi Al

You know I realised that overnight, and had meant to post a revision
this
morning, but completely forgot. Little point in moving both name and
Roster.

The following amended code, still copies the main first block of roster
information down for the other three weeks (just in case you decide to
amend
the roster itself), but the "shuffle, only takes place on column A for
Names.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


I hope this now resolves the problem.

--
Regards
Roger Govier



"gramps" wrote in message
...
Hi Roger
Thanks for your reply but there appears to be a snag in that although
the
names move down a line each week so does the duty line move down as
well
so
that each person remains doing the same duties for each week. What
needs
to
happen is that either the names or the duties move down each week but
not
both.
Thanks again for your help
--
Al


"Roger Govier" wrote:

Hi

With your first set of days appearing in cells B4:H4, and the
subsequent
sets of day headings being on rows 16, 28 and 40.
In cell A1 enter the date of the start of the 4 week pay period e.g.
28/07/2007

In cell A4 enter
="W/C "&TEXT($A$1+(INT(ROW()/12)*7),"dd/mm/yy")
Copy this formula to cells A16, A28 and A40

This will ensure that each row of days has the appropriate W/C date
corresponding to the value you have entered in A1.

Copy the following event code and paste it into the Sheet module of
the
relevant sheet from your workbook.
To do this, Mark the codeControl +C to copyRight click on your
sheet
tabView CodeControl + V to paste the code into the sheet module.
Press Alt + F11 to return to your worksheet.

Copy your current (starting rota) to cells A5:H14

Now, enter the date again into cell A1, and as soon as you press
Enter,
the
rota will be copied down and adjusted.
Each time you change the value in cell A1, this will be repeated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Range(Cells(m, 1), Cells(m, 8)).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


--
Regards
Roger Govier



"gramps" wrote in message
...

-- I operate the 10 week rotating roster as shown below. I need
to be
able
to perform 2 separate tasks the first of which is to enter a start
date
of
the week and then as each new week starts the names drop down 1
line
and
the
bottom name then goes back to the top of the roster.

The pay period is a 4 week cycle and so what I would also like to
be
able
to
do is post each person their duties for the next 4 week cycle
which
would
automatically update when the new period's start date is entered

Saturday Sunday Monday Tuesday Wednesday Thursday Friday
Duncan Rest A2 C2 A2 Rest C1 C1
Barbara C1 Rest Rest C2 C2 C2 C2
Rachel N2 Rest D1 D1 D1 D1 Rest
Latiffe A1 A1 C1 C1 C1 Rest Rest
Ali Rest Rest N2 N2 N2 N2 N2
Tony Rest C1 N1 N1 N1 Rest D1
Jorge N1 N1 Rest Rest A2 A2 A2
John A2 Rest NW NW Rest NW NW
Bryan Rest Rest A1 A1 A1 A1 A1
George Rest N2 A2 Rest NW N1 N1

Any help would be greatly appreciated.
Al

Hi Al
For your 10 employee scenario
Initial setting
n = 5: m = 14: o = 17
each time through loop
n = n + 12: m = m + 12: o = o + 12

n is the starting row number, Employee 1
m is the last employee row number, Employee 10
o is the row number for the 1st Employee in the second week.

12 is the add-on each time (based upon 10 employees and 3 row interval 2
blank lines, 1 line of days)

so, for 5 employees change those 2 lines in the code to
n=5 : m=9 : o=12
n=n+7:m=m+7:o=o+7

--
Regards
Roger Govier



"gramps" wrote in message
...
Hi Roger
Sorry, I didn't explain what I meant properly. What I was wondering was
what
changes to make if it was only a 5 man rota but to still show 4 weeks at a
time.
Thanks again
--
Al
"Roger Govier" wrote:

Hi

Just change the size of the loop from 3 to 4
For i = 1 To 3

For i = 1 To 4
--
Regards
Roger Govier




Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address < "$A$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim n As Long, m As Long, o As Long, i As Long
n = 5: m = 14: o = 17

For i = 1 To 3
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown

Range(Cells(n, 1), Cells(m, 8)).Copy Cells(o, 1)
n = n + 12: m = m + 12: o = o + 12
Next i
Cells(m, 1).Select
Application.CutCopyMode = False
Selection.Cut
Cells(n, 1).Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub


I hope this now resolves the problem.

--
Regards
Roger Govier