For next loop carries on after criteria is met changing other cells????

[Simon Lloyd]

Hi all I have some code below that looks for a date in an array o
sheets when it finds it select an offset and colour it red this work
(sort of!) but after it has found the cell im looking for and coloure
it it then does the same for the next cell below the one t found and s
on......how can i smarten this up and get it only to act on the criteri
i set?

Hope you can help!
Regards,
Simon
P.S i have included the rest of the code that is used within th
userform, staffdates is in the userform module!

Sub staffdates()

Dim wks As Worksheet
Dim rng As Range
Dim arr As Variant
Dim mycell
dv = ComboBox2.Text
sn = ComboBox1.Text

arr = Array("Week1", "Week2", "Week3", "Week4", "Week5", _
"Week6")

Application.EnableEvents = False

For Each wks In Worksheets(arr)
wks.Visible = xlSheetVisible
Set rng = Sheets(wks.Name).Range("A1:A300")
For Each mycell In rng

If mycell.Text = dv Then
End If
MsgBox "found " & mycell.Text
Sheets("Week Selection").Visible = False
With Worksheets(arr)
If sn = "Lauren" Then
mycell.Offset(1, 1).Select
ElseIf sn = "Emma" Then
mycell.Offset(1, 5).Select
ElseIf sn = "Cheryl" Then
mycell.Offset(1, 9).Select
End If
End With
Call cchange

Next mycell
Exit Sub
Worksheets("Week Selection").Visible = True
wks.Visible = xlSheetHidden
Next wks

Application.EnableEvents = True

Unload Me
End Sub

Sub cchange()
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Unload UserForm3
Exit Sub
End Sub

Private Sub ComboBox2_Change()
ComboBox2 = Format(ComboBox2.Value, "dd mmmm yyyy")
End Sub

Private Sub CommandButton1_Click()
Call staffdates

End Su

 

[Jim Thomlinson]

I'm lost. What exactly is ist supposed to do. Specifially when is it supposed
to end.

 

[Simon Lloyd]

Hi Jim thanks for replying, once it has found the date selected on the
userform and then performed the offset depending on the criteria
selected in the remaining combobox on the userform it should change the
colour of the selected offset and then end as there will be no
duplicates of the date on any of the sheets!, trouble is it isnt ending
it then selects another offset below the last one and carries on, the
only way it doesnt colour a whole row is because i have put a MsgBox in
to show me that it has found what i am looking for!

Regards,
Simon

 

[Jim Thomlinson]

You probably want to use an exit for statement and a boolean flag to indicate
whether you want to keep going or not...

Sub staffdates()

Dim wks As Worksheet
Dim rng As Range
Dim arr As Variant
Dim mycell
Dim blnFound as Boolean

dv = ComboBox2.Text
sn = ComboBox1.Text

arr = Array("Week1", "Week2", "Week3", "Week4", "Week5", _
"Week6")
blnFound = false
Application.EnableEvents = False

For Each wks In Worksheets(arr)
wks.Visible = xlSheetVisible
Set rng = Sheets(wks.Name).Range("A1:A300")
For Each mycell In rng

If mycell.Text = dv Then
End If '**What is this for???
MsgBox "found " & mycell.Text
blnFound = true
Sheets("Week Selection").Visible = False
With Worksheets(arr)
If sn = "Lauren" Then
mycell.Offset(1, 1).Select
ElseIf sn = "Emma" Then
mycell.Offset(1, 5).Select
ElseIf sn = "Cheryl" Then
mycell.Offset(1, 9).Select
End If
End With
Call cchange
if blnfound then exit for
Next mycell
Exit Sub
Worksheets("Week Selection").Visible = True
wks.Visible = xlSheetHidden
if blnfound then exit for
Next wks

Application.EnableEvents = True

Unload Me
End Sub

Sub cchange()
With Selection.Interior
..ColorIndex = 3
..Pattern = xlSolid
..PatternColorIndex = xlAutomatic
End With
Unload UserForm3
Exit Sub
End Sub

Private Sub ComboBox2_Change()
ComboBox2 = Format(ComboBox2.Value, "dd mmmm yyyy")
End Sub

Private Sub CommandButton1_Click()
Call staffdates

End Sub

 

[Dave Peterson]

Maybe...

Option Explicit
Sub staffdates()

Dim wks As Worksheet
Dim rng As Range
Dim arr As Variant
Dim mycell As Range
Dim FoundIt As Boolean
dv = ComboBox2.Text
sn = ComboBox1.Text

arr = Array("Week1", "Week2", "Week3", "Week4", "Week5", _
"Week6")

Application.EnableEvents = False

For Each wks In Worksheets(arr)
FoundIt = False
wks.Visible = xlSheetVisible
wks.Select 'so you can select the ranges below
Set rng = wks.Range("A1:A300")
For Each mycell In rng

'what did this do?
'If mycell.Text = dv Then
'End If

'more testing stuff
'MsgBox "found " & mycell.Text
'Sheets("Week Selection").Visible = False

With wks
If sn = "Lauren" Then
mycell.Offset(1, 1).Select
FoundIt = True
ElseIf sn = "Emma" Then
mycell.Offset(1, 5).Select
FoundIt = True
ElseIf sn = "Cheryl" Then
mycell.Offset(1, 9).Select
FoundIt = True
End If
End With

If FoundIt = True Then
Call cchange
Exit For 'leave that worksheet
End If
Next mycell

Worksheets("Week Selection").Visible = True
wks.Visible = xlSheetHidden
Next wks

Application.EnableEvents = True

Unload Me
End Sub

==========
Or maybe without the selecting...

Option Explicit
Sub staffdates()

Dim wks As Worksheet
Dim rng As Range
Dim arr As Variant
Dim mycell As Range
Dim FoundIt As Boolean
dv = ComboBox2.Text
sn = ComboBox1.Text

arr = Array("Week1", "Week2", "Week3", "Week4", "Week5", "Week6")

Application.EnableEvents = False

For Each wks In Worksheets(arr)
FoundIt = False
wks.Visible = xlSheetVisible
wks.Select 'so you can select the ranges below
Set rng = wks.Range("A1:A300")
For Each mycell In rng.Cells
With wks
If sn = "Lauren" Then
Call cchange(mycell.Offset(1, 1))
FoundIt = True
ElseIf sn = "Emma" Then
Call cchange(mycell.Offset(1, 5))
FoundIt = True
ElseIf sn = "Cheryl" Then
Call cchange(mycell.Offset(1, 9))
FoundIt = True
End If
End With

If FoundIt = True Then
'Call cchange
Exit For 'leave that worksheet
End If
Next mycell
Next wks

Application.EnableEvents = True

Unload Me
End Sub

Sub cchange(myRng As Range)
With myRng.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'Unload UserForm3

End Sub

All untested!

 

[RB Smissaert]

4 things:

Not sure what is going on here:
If mycell.Text = dv Then
End If

Get the free smart indenter it makes reading the code much easier:
http://www.oaltd.co.uk/Indenter/Default.htm

Mybe it is just me, but I think the ElseIf construction is not as clear as
just doing the full
Else
If
End If
etc.

Try to avoid all those selects and work directly on a specified range,
without first
selecting. There is no need for it, you might mistakenly think a range is
selected where it isn't and
it will slow down your code. You call cchange with a range argument and do
the formatting
on that passed range.

If you alter all these 4 things you may find the problem and the solution.


RBS



"Simon Lloyd" <[email protected]>
wrote in message

 

[Simon Lloyd]

Gentlemen....thanks for the response, Jim your solution did indeed find
the offset an colour it, the rogue End If was for the first criteria to
be looked for and that was the value of Combobox2 and then perform the
offset...but i kind of messed that bit up....Dave, your solutions
worked as well finding the first offset and colouring them....but did
it on all pages! again probably because of my omission for the first
criteria.

I had a brainwave (well more of a ripple!) rather than going to the
trouble of colouring the required cell and then having to colour it
back manually is it possible with the code below to look at a named
range called StaffHols find a match for combobox2 (which would appear
in the first column of the named range) then when the code looks at the
specific sheet and then day look at the first cell in the selected day
range (in the select case below) and if the date in that cell matches
any of the dates (in column 2 of the named range) opposite the match
for the name found in the named range then MsgBox blah blah and back to
the userform so they can choose another person or sheet or day.

More of a brain dump than wave but i will try to clarify further if you
need!
Regards,
Simon

Public Sub FindSlot()

Dim rng As Range
Dim w, t, s As Variant
Dim r As Range
Dim mycell

Application.EnableEvents = False
w = UserForm2.ComboBox3.Value ''''Contains the name of the worksheet to
look in
s = UserForm2.ComboBox2.Value ''''Contains the name of the person to
look at
Worksheets(w).Visible = True
Worksheets(w).Select
t = UserForm2.ComboBox1.Value 'Contains which day to look at

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

On Error GoTo cls
Application.EnableEvents = False

For Each mycell In r
If mycell.Text = UserForm2.ListBox1.Text Then ''''Listbox1 contains a
time to look at
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

End Sub