Couldn't you have combined your select case
case Is = "Tuesday"
Set r = .Range("A4:A46")
Set r2 = .Range("A1")
====
you may want to play with this idea instead of select case.
Sub chooseit()
t = yourvalue 'Range("e2").Value
myarray = Array("Tue", "Wed", "Thu", "Fri", "Sat")
x = (Application.Match(left(t,3), myarray, 0) - 1) * 48 + 1
'MsgBox x + 45
Set r = Range("a" & x & ":a" & x + 45)
'r.Select
Set r2 = Range("a" & x)
'r2.Select
End Sub
'*need to fix your first table to conform with the others 1-45

--
Don Guillett
SalesAid Software

"Simon Lloyd"
wrote in message
...

Hi all, i have managed to work out how to do a vlookup in VBA which
helps me check some criteria before moving on with the rest of the
code, at this moment in time it looks for a name and a date in a named
range and if it exists bring up a MsgBox..............I'm just having
one problem with it, and that is the vlookup stops at the first match
it comes across, so if my named range looked like this: (a & b are the
columns)
A.........B
Emma 14/7/06
Cheryl 15/7/06
Lauren16/7/06
Cheryl 14/7/06
If with my userform i look for Emma 14/7/06 the vlookup will find it no
problem if i go back to my userform and choose a new name "Cheryl"
14/7/06 it will only see the first "Cheryl" it comes across which is
15/7/06 anyone know how to fix this?

Public Sub FindSlot()
Dim rng As Range
Dim w, t, s, d As Variant
Dim r As Range
Dim mycell
Dim r2

Application.EnableEvents = False
w = UserForm2.ComboBox3.Value
s = UserForm2.ComboBox2.Value
Worksheets(w).Visible = True
Worksheets(w).Select
t = UserForm2.ComboBox1.Value
d = Application.VLookup(UserForm2.ComboBox2.Text, Range("StaffHols"),
(2), False)

With Worksheets(w)
Select Case t
Case Is = "Tuesday"
Set r = .Range("A4:A46")
Case Is = "Wednesday"
Set r = .Range("A49:A94")
Case Is = "Thursday"
Set r = .Range("A97:A142")
Case Is = "Friday"
Set r = .Range("A145:A190")
Case Is = "Saturday"
Set r = .Range("A193:A238")
End Select
End With
With Worksheets(w)
Select Case t
Case Is = "Tuesday"
Set r2 = .Range("A1")
Case Is = "Wednesday"
Set r2 = .Range("A49")
Case Is = "Thursday"
Set r2 = .Range("A97")
Case Is = "Friday"
Set r2 = .Range("A145")
Case Is = "Saturday"
Set r2 = .Range("A193")
End Select
End With
'On Error GoTo cls
Application.EnableEvents = False
For Each mycell In r2
If d < "" And d = r2 Then
MsgBox "Not available " & s & " is on holiday!" & Chr(13) & "Please
choose another week, day or stylist!"

Exit Sub
End If
Next
For Each mycell In r
If mycell.Text = UserForm2.ListBox1.Text Then
mycell.Select
UserForm2.Hide

Select Case s
Case Is = "Lauren"
c = 1: GoSub TestSlot
Case Is = "Emma"
c = 5: GoSub TestSlot
Case Is = "Cheryl"
c = 9: GoSub TestSlot
End Select

End If


Next mycell


Worksheets("Week Selection").Visible = True
Worksheets(w).Visible = False

cls:
Application.EnableEvents = True
Unload UserForm2

Exit Sub

TestSlot:
If mycell.Offset(0, c) < "" And mycell.Offset(0, c + 2) < "" Then
Msg = "Please Choose New Time, Day or Week... " & mycell.Value & "
For " & s & " Is Taken!"
MsgBox Msg, vbOKOnly, "Time Slot Taken"
UserForm2.Show
ElseIf mycell.Offset(0, c) = "" Or mycell.Offset(0, c + 2) = ""
Then
Answer = MsgBox(" Chosen Time Has An Empty Slot" & Chr(13) &
"Click Yes to Make Booking or Click No To Exit", vbYesNo, "Make A
Booking?")
If Answer = vbYes Then
Unload UserForm2
UserForm1.Show
End If
End If
Return
Set d = Nothing

End Sub


--
Simon Lloyd
------------------------------------------------------------------------
Simon Lloyd's Profile:
http://www.excelforum.com/member.php...fo&userid=6708
View this thread: http://www.excelforum.com/showthread...hreadid=559607