Is there a way to have this loop 25 times.

That is these three values would increment once each time though the loop:
Weeks1(), x = 1, and worksheets(1)
Weeks2(), x = 2, and worksheets(2)

Weeks3(), x = 3, and worksheets(3)

Weeks4(), x = 4, and worksheets(4)

Weeks5(), x = 5, and worksheets(5)



Sub Weeks1()
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim x As Integer
x = 1
Dim Sheet1Values As Variant
Worksheets(1).Activate


Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, Sheet1Values


Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x, 15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, sheetValues)
Dim rng As Range
With Worksheets(1)
Do While r <= maxR
Set rng = .Cells(r, 3).Resize(1, 5)
Select Case sheetValues(1, c)
Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)
End Select
r = r + 1
c = c + 1
Loop
End With
End Sub

Moving x up to be an argument:

Not sure if this is exactly what you want though...


Sub test()
Weeks 1
Weeks 2
Weeks 3
Weeks 4
Weeks 5
End Sub


Sub Weeks(x As Long)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column

Dim SheetValues As Variant
Worksheets(x).Activate


SheetValues = Worksheets(x).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, SheetValues


SheetValues = Worksheets(x).Range(Cells(x, 9), Cells(x, 15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, SheetValues

End Sub



--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Max Bialystock" wrote in message
...
Is there a way to have this loop 25 times.

That is these three values would increment once each time though the
loop:
Weeks1(), x = 1, and worksheets(1)
Weeks2(), x = 2, and worksheets(2)

Weeks3(), x = 3, and worksheets(3)

Weeks4(), x = 4, and worksheets(4)

Weeks5(), x = 5, and worksheets(5)



Sub Weeks1()
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim x As Integer
x = 1
Dim Sheet1Values As Variant
Worksheets(1).Activate


Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, Sheet1Values


Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x,
15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, sheetValues)
Dim rng As Range
With Worksheets(1)
Do While r <= maxR
Set rng = .Cells(r, 3).Resize(1, 5)
Select Case sheetValues(1, c)
Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)
End Select
r = r + 1
c = c + 1
Loop
End With
End Sub

Sub test()
For Each sh In
Worksheets(Array("Sheet1","Sheet2","Sheet3","Sheet 4","Sheet5")
Weeks 1,sh
Weeks 2,sh
Weeks 3,sh
Weeks 4,sh
Weeks 5,sh
End Sub


Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)). _
Resize(1,7).Value
WeekNum 7,1, 13, SheetValues
SheetValues = .Range(Cells(x, 9), Cells(x, 15)). _
Resize(1,7).Value

WeekNum 17,1, 23, SheetValues
End With
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Is there a way to have this loop 25 times.

That is these three values would increment once each time though the
loop:
Weeks1(), x = 1, and worksheets(1)
Weeks2(), x = 2, and worksheets(2)

Weeks3(), x = 3, and worksheets(3)

Weeks4(), x = 4, and worksheets(4)

Weeks5(), x = 5, and worksheets(5)



Sub Weeks1()
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim x As Integer
x = 1
Dim Sheet1Values As Variant
Worksheets(1).Activate


Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, Sheet1Values


Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x,
15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, sheetValues)
Dim rng As Range
With Worksheets(1)
Do While r <= maxR
Set rng = .Cells(r, 3).Resize(1, 5)
Select Case sheetValues(1, c)
Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)
End Select
r = r + 1
c = c + 1
Loop
End With
End Sub

Syntax fixed

Sub test()
For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4",
"Sheet5"))
Weeks 1, sh
Weeks 2, sh
Weeks 3, sh
Weeks 4, sh
Weeks 5, sh
Next sh
End Sub

I've aircoded too :)

--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Bob Phillips" wrote in message
...
Sub test()
For Each sh In
Worksheets(Array("Sheet1","Sheet2","Sheet3","Sheet 4","Sheet5")
Weeks 1,sh
Weeks 2,sh
Weeks 3,sh
Weeks 4,sh
Weeks 5,sh
End Sub


Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)). _
Resize(1,7).Value
WeekNum 7,1, 13, SheetValues
SheetValues = .Range(Cells(x, 9), Cells(x, 15)). _
Resize(1,7).Value

WeekNum 17,1, 23, SheetValues
End With
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Is there a way to have this loop 25 times.

That is these three values would increment once each time though the
loop:
Weeks1(), x = 1, and worksheets(1)
Weeks2(), x = 2, and worksheets(2)

Weeks3(), x = 3, and worksheets(3)

Weeks4(), x = 4, and worksheets(4)

Weeks5(), x = 5, and worksheets(5)



Sub Weeks1()
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim x As Integer
x = 1
Dim Sheet1Values As Variant
Worksheets(1).Activate


Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x,
8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, Sheet1Values


Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x,
15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, sheetValues)
Dim rng As Range
With Worksheets(1)
Do While r <= maxR
Set rng = .Cells(r, 3).Resize(1, 5)
Select Case sheetValues(1, c)
Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)
End Select
r = r + 1
c = c + 1
Loop
End With
End Sub

Gentlemen I thank you sincerely for your help.
But how do I keep this bit in synchronisation with the other bits?



Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
Dim rng As Range
With Worksheets(?)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub

With Worksheets(?) has to have the same value as each of the sheets in the
array shown below.

Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub

--
Regards,
Max


"Rob van Gelder" wrote in message
...
Syntax fixed

Sub test()
For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3",
"Sheet4",
"Sheet5"))
Weeks 1, sh
Weeks 2, sh
Weeks 3, sh
Weeks 4, sh
Weeks 5, sh
Next sh
End Sub

I've aircoded too :)

--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Bob Phillips" wrote in message
...
Sub test()
For Each sh In
Worksheets(Array("Sheet1","Sheet2","Sheet3","Sheet 4","Sheet5")
Weeks 1,sh
Weeks 2,sh
Weeks 3,sh
Weeks 4,sh
Weeks 5,sh
End Sub


Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)). _
Resize(1,7).Value
WeekNum 7,1, 13, SheetValues
SheetValues = .Range(Cells(x, 9), Cells(x, 15)). _
Resize(1,7).Value

WeekNum 17,1, 23, SheetValues
End With
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Is there a way to have this loop 25 times.

That is these three values would increment once each time though the
loop:
Weeks1(), x = 1, and worksheets(1)
Weeks2(), x = 2, and worksheets(2)

Weeks3(), x = 3, and worksheets(3)

Weeks4(), x = 4, and worksheets(4)

Weeks5(), x = 5, and worksheets(5)



Sub Weeks1()
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim x As Integer
x = 1
Dim Sheet1Values As Variant
Worksheets(1).Activate


Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x,
8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, Sheet1Values


Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x,
15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, sheetValues)
Dim rng As Range
With Worksheets(1)
Do While r <= maxR
Set rng = .Cells(r, 3).Resize(1, 5)
Select Case sheetValues(1, c)
Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)
End Select
r = r + 1
c = c + 1
Loop
End With
End Sub

What exactly does that question mean?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Gentlemen I thank you sincerely for your help.
But how do I keep this bit in synchronisation with the other bits?



Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
Dim rng As Range
With Worksheets(?)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub

With Worksheets(?) has to have the same value as each of the sheets in the
array shown below.

Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub

--
Regards,
Max


"Rob van Gelder" wrote in message
...
Syntax fixed

Sub test()
For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3",
"Sheet4",
"Sheet5"))
Weeks 1, sh
Weeks 2, sh
Weeks 3, sh
Weeks 4, sh
Weeks 5, sh
Next sh
End Sub

I've aircoded too :)

--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Bob Phillips" wrote in message
...
Sub test()
For Each sh In
Worksheets(Array("Sheet1","Sheet2","Sheet3","Sheet 4","Sheet5")
Weeks 1,sh
Weeks 2,sh
Weeks 3,sh
Weeks 4,sh
Weeks 5,sh
End Sub


Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)). _
Resize(1,7).Value
WeekNum 7,1, 13, SheetValues
SheetValues = .Range(Cells(x, 9), Cells(x, 15)). _
Resize(1,7).Value

WeekNum 17,1, 23, SheetValues
End With
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Is there a way to have this loop 25 times.

That is these three values would increment once each time though
the
loop:
Weeks1(), x = 1, and worksheets(1)
Weeks2(), x = 2, and worksheets(2)

Weeks3(), x = 3, and worksheets(3)

Weeks4(), x = 4, and worksheets(4)

Weeks5(), x = 5, and worksheets(5)



Sub Weeks1()
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the
worksheet
column
Dim x As Integer
x = 1
Dim Sheet1Values As Variant
Worksheets(1).Activate


Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x,
8)).Resize(1,
7).Value
r = 7
c = 1
WeekNum r, c, 13, Sheet1Values


Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x,
15)).Resize(1,
7).Value
r = 17
c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, sheetValues)
Dim rng As Range
With Worksheets(1)
Do While r <= maxR
Set rng = .Cells(r, 3).Resize(1, 5)
Select Case sheetValues(1, c)
Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)
End Select
r = r + 1
c = c + 1
Loop
End With
End Sub

Thanks Rob!

Bob

"Rob van Gelder" wrote in message
...
Syntax fixed

Sub test()
For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3",
"Sheet4",
"Sheet5"))
Weeks 1, sh
Weeks 2, sh
Weeks 3, sh
Weeks 4, sh
Weeks 5, sh
Next sh
End Sub

I've aircoded too :)

--
Rob van Gelder - http://www.vangelder.co.nz/excel

In
---
Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
With Worksheets(4)
---
what do I put in place of the 4 in worksheets(4)?



Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub
Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues
SheetValues = Range(Cells(x, 9), Cells(x, 15)).Resize(1, 7).Value
WeekNum 17, 1, 23, SheetValues
End With
End Sub
Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
With Worksheets(4)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub

Hi Max,

Sorry, missed that one

Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub
Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = Range(Cells(x, 9), Cells(x, 15)).Resize(1, 7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With
End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues, sh As
Worksheet)

With Worksheets(sh)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
In
---
Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
With Worksheets(4)
---
what do I put in place of the 4 in worksheets(4)?



Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub
Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues
SheetValues = Range(Cells(x, 9), Cells(x, 15)).Resize(1, 7).Value
WeekNum 17, 1, 23, SheetValues
End With
End Sub
Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
With Worksheets(4)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub

Hi Bob and thanks very much for all your help,

The routine stops at:
With Worksheets(sh)
with an error message 13 type mismatch.

I can't see what's wrong, but then I'm in a little over my head here.


--
Regards,
Max



"Bob Phillips" wrote in message
...
Hi Max,

Sorry, missed that one

Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub
Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = Range(Cells(x, 9), Cells(x, 15)).Resize(1, 7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With
End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues, sh As
Worksheet)

With Worksheets(sh)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
In
---
Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
With Worksheets(4)
---
what do I put in place of the 4 in worksheets(4)?



Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4", "5", "6", "7", "8"))
Weeks 4, sh
Weeks 5, sh
Weeks 6, sh
Weeks 7, sh
Weeks 8, sh
Next sh
End Sub
Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet
column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues
SheetValues = Range(Cells(x, 9), Cells(x, 15)).Resize(1,
7).Value
WeekNum 17, 1, 23, SheetValues
End With
End Sub
Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)
With Worksheets(4)

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub

Sorry Max, I am losing it today.

Change that

With Worksheets(sh)

to

With sh

The problem was that sh was a worksheet object, and I was trying to use it
as a worksheet name string. Total **£$?!* on my part.

Fingers crossed.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Hi Bob and thanks very much for all your help,

The routine stops at:
With Worksheets(sh)
with an error message 13 type mismatch.

I can't see what's wrong, but then I'm in a little over my head here.


--
Regards,
Max

Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet 8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

With many thanks for your help so far,
Regards,
Max
-----------

Option Explicit

Sub test()
Worksheets(1).Activate
Dim sh As Worksheet
For Each sh In Worksheets(Array("4"))
Weeks 4, sh
'Weeks 5, sh
'Weeks 6, sh
'Weeks 7, sh
'Weeks 8, sh
Next sh
End Sub
Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With sh
SheetValues = Range(Cells(x, 2), Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = Range(Cells(x, 9), Cells(x, 15)).Resize(1, 7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With
End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues, sh As
Worksheet)
Dim rng As Range
With sh

Do While r <= maxR

Set rng = .Cells(r, 3).Resize(1, 5)
Select Case SheetValues(1, c)

Case 0
rng.Value = Array(0, 0, 0, "RDO", 0)
Case "a", "e"
rng.Value = Array("9:00", "17:21", "0:45", 0, 0)

End Select

r = r + 1
c = c + 1

Loop
End With

End Sub



























"Bob Phillips" wrote in message
...
Sorry Max, I am losing it today.

Change that

With Worksheets(sh)

to

With sh

The problem was that sh was a worksheet object, and I was trying to use it
as a worksheet name string. Total **£$?!* on my part.

Fingers crossed.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
Hi Bob and thanks very much for all your help,

The routine stops at:
With Worksheets(sh)
with an error message 13 type mismatch.

I can't see what's wrong, but then I'm in a little over my head here.


--
Regards,
Max

Hi Max,


"Max Bialystock" wrote in message
...
Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet 8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in
sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

Get out of here! We'll crack it.

The biggest difficulty I have is envisaging eaxctly what you arev trying to
do, as I obviously don't have the data or the requirements as you know them.

Having said that, the Weeks procedure looks wrong. Try this variation and
let me know.

Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With Worksheets(1)
SheetValues = .Range(.Cells(x, 2), .Cells(x, 8)).Resize(1, 7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = .Range(.Cells(x, 9), .Cells(x, 15)).Resize(1, 7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With

End Sub

Bob,

I copied that exactly and it made no difference.

I'll send you a description of what's going on, separately.

Max

"Bob Phillips" wrote in message
...
Hi Max,


"Max Bialystock" wrote in message
...
Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet 8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in
sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

Get out of here! We'll crack it.

The biggest difficulty I have is envisaging eaxctly what you arev trying
to
do, as I obviously don't have the data or the requirements as you know
them.

Having said that, the Weeks procedure looks wrong. Try this variation and
let me know.

Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With Worksheets(1)
SheetValues = .Range(.Cells(x, 2), .Cells(x, 8)).Resize(1,
7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = .Range(.Cells(x, 9), .Cells(x, 15)).Resize(1,
7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With

End Sub

Sheet 1 is a page for the user to work out a roster for a fortnight.



The dates are in B2:O2.



The names of the staff are in A4:A25.



If a cell is empty or contains a zero the worker has that day off.



If a cell contains an "a" they work a normal shift.



Sheets 4 to 25 are the attendance/payroll input sheets.



Sheet 4 corresponds with the name in sheet1 A4.



HR insist on a specific format for these sheets and this is where much of
the difficulty lies. Information to be included is:

the start time sheet4 C7

the finish time sheet 4 D7

the meal break sheet4 E7

the type of leave sheet 4 F7

the amount of leave (h:mm) sheet 4 G7

the total hours worked (h:mm) sheet 4 H7.



So an "a" in sheet 1 B4 has to translate as (09:00, 17:30, 0:45, 0, ) on
sheet 4.

H7 contains formula, which calculates the hours worked.



To further complicate things the fortnight is divided into two weeks.



The first week of the fortnight occupies the range C7:H7, C13:H13.

The second week C17:H17, C23:H23.


















"Bob Phillips" wrote in message
...
Hi Max,


"Max Bialystock" wrote in message
...
Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet 8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in
sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

Get out of here! We'll crack it.

The biggest difficulty I have is envisaging eaxctly what you arev trying
to
do, as I obviously don't have the data or the requirements as you know
them.

Having said that, the Weeks procedure looks wrong. Try this variation and
let me know.

Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With Worksheets(1)
SheetValues = .Range(.Cells(x, 2), .Cells(x, 8)).Resize(1,
7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = .Range(.Cells(x, 9), .Cells(x, 15)).Resize(1,
7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With

End Sub

This is how I used to do it with a separate routine for each sheet.

Sub Weeks()

Weeks4

Weeks5

Weeks6

Weeks7

Weeks8

Weeks9

Weeks10

Weeks11

Weeks12

Weeks13

Weeks14

Weeks15

Weeks16

Weeks17

Weeks18

Weeks19

Weeks20

Weeks21

Weeks22

End Sub

Sub Weeks4()

Dim r As Long 'this points to the worksheet row

Dim c As Long 'this points to the array column, not the worksheet column

Dim x As Integer

x = 4

Dim Sheet1Values As Variant

Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value

r = 7

c = 1

WeekNum r, c, 13, Sheet1Values



Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x, 15)).Resize(1,
7).Value

r = 17

c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)

Dim rng As Range



With Worksheets(4)



Do While r <= maxR



Set rng = .Cells(r, 3).Resize(1, 5)

Select Case SheetValues(1, c)



Case 0

rng.Value = Array(0, 0, 0, "RDO", 0)

Case "a", "e"

rng.Value = Array("9:00", "17:21", "0:45", 0, 0)



End Select



r = r + 1

c = c + 1



Loop

End With



End Sub





"Bob Phillips" wrote in message
...
Hi Max,


"Max Bialystock" wrote in message
...
Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet 8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in
sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

Get out of here! We'll crack it.

The biggest difficulty I have is envisaging eaxctly what you arev trying
to
do, as I obviously don't have the data or the requirements as you know
them.

Having said that, the Weeks procedure looks wrong. Try this variation and
let me know.

Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With Worksheets(1)
SheetValues = .Range(.Cells(x, 2), .Cells(x, 8)).Resize(1,
7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = .Range(.Cells(x, 9), .Cells(x, 15)).Resize(1,
7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With

End Sub

Max,

Do you want to send me the workbook directly as well?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Max Bialystock" wrote in message
...
This is how I used to do it with a separate routine for each sheet.

Sub Weeks()

Weeks4

Weeks5

Weeks6

Weeks7

Weeks8

Weeks9

Weeks10

Weeks11

Weeks12

Weeks13

Weeks14

Weeks15

Weeks16

Weeks17

Weeks18

Weeks19

Weeks20

Weeks21

Weeks22

End Sub

Sub Weeks4()

Dim r As Long 'this points to the worksheet row

Dim c As Long 'this points to the array column, not the worksheet
column

Dim x As Integer

x = 4

Dim Sheet1Values As Variant

Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value

r = 7

c = 1

WeekNum r, c, 13, Sheet1Values



Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x,
15)).Resize(1,
7).Value

r = 17

c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)

Dim rng As Range



With Worksheets(4)



Do While r <= maxR



Set rng = .Cells(r, 3).Resize(1, 5)

Select Case SheetValues(1, c)



Case 0

rng.Value = Array(0, 0, 0, "RDO", 0)

Case "a", "e"

rng.Value = Array("9:00", "17:21", "0:45", 0, 0)



End Select



r = r + 1

c = c + 1



Loop

End With



End Sub





"Bob Phillips" wrote in message
...
Hi Max,


"Max Bialystock" wrote in message
...
Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet
8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in
sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

Get out of here! We'll crack it.

The biggest difficulty I have is envisaging eaxctly what you arev trying
to
do, as I obviously don't have the data or the requirements as you know
them.

Having said that, the Weeks procedure looks wrong. Try this variation
and
let me know.

Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With Worksheets(1)
SheetValues = .Range(.Cells(x, 2), .Cells(x, 8)).Resize(1,
7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = .Range(.Cells(x, 9), .Cells(x, 15)).Resize(1,
7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With

End Sub