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