+ Reply to Thread
Results 1 to 7 of 7

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

  1. #1
    Forum Expert Simon Lloyd's Avatar
    Join Date
    03-02-2004
    Location
    locked in the cage
    MS-Off Ver
    All the ones my homepage shows
    Posts
    3,161

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

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

    Hope you can help!
    Regards,
    Simon
    P.S i have included the rest of the code that is used within the 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 Sub

  2. #2
    Jim Thomlinson
    Guest

    RE: For next loop carries on after criteria is met changing other cell

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

    Jim Thomlinson


    "Simon Lloyd" wrote:

    >
    > Hi all I have some code below that looks for a date in an array of
    > sheets when it finds it select an offset and colour it red this works
    > (sort of!) but after it has found the cell im looking for and coloured
    > it it then does the same for the next cell below the one t found and so
    > on......how can i smarten this up and get it only to act on the criteria
    > i set?
    >
    > Hope you can help!
    > Regards,
    > Simon
    > P.S i have included the rest of the code that is used within the
    > 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 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=559067
    >
    >


  3. #3
    Forum Expert Simon Lloyd's Avatar
    Join Date
    03-02-2004
    Location
    locked in the cage
    MS-Off Ver
    All the ones my homepage shows
    Posts
    3,161
    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 Column is because i have put a MsgBox in to show me that it has found what i am looking for!

    Regards,
    Simon

  4. #4
    Jim Thomlinson
    Guest

    Re: For next loop carries on after criteria is met changing other

    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

    --
    HTH...

    Jim Thomlinson


    "Simon Lloyd" wrote:

    >
    > 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
    >
    >
    > --
    > Simon Lloyd
    > ------------------------------------------------------------------------
    > Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708
    > View this thread: http://www.excelforum.com/showthread...hreadid=559067
    >
    >


  5. #5
    Dave Peterson
    Guest

    Re: For next loop carries on after criteria is met changing othercells????

    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!

    Simon Lloyd wrote:
    >
    > 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
    >
    > --
    > Simon Lloyd
    > ------------------------------------------------------------------------
    > Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708
    > View this thread: http://www.excelforum.com/showthread...hreadid=559067


    --

    Dave Peterson

  6. #6
    RB Smissaert
    Guest

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

    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
    news:[email protected]...
    >
    > Hi all I have some code below that looks for a date in an array of
    > sheets when it finds it select an offset and colour it red this works
    > (sort of!) but after it has found the cell im looking for and coloured
    > it it then does the same for the next cell below the one t found and so
    > on......how can i smarten this up and get it only to act on the criteria
    > i set?
    >
    > Hope you can help!
    > Regards,
    > Simon
    > P.S i have included the rest of the code that is used within the
    > 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 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=559067
    >



  7. #7
    Forum Expert Simon Lloyd's Avatar
    Join Date
    03-02-2004
    Location
    locked in the cage
    MS-Off Ver
    All the ones my homepage shows
    Posts
    3,161
    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

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1