Can(Should) this sub be shortened?

R

rcicconetti

New Member
Joined
Jan 16, 2016
Messages
34
Can(should) this sub be shortened?

This code is used in a Scheduling workbook to alert the user that there is a scheduling conflict...and it works well, HOWEVER:

This only represents 1 DEPARTMENT for 1 full Day. There are 6 departments scheduled over 14 days, and the all have AM and PM shifts. So the code below would be repeated 168 times with slight variations that will address different ranges.

Is there a more efficient way to write this?
Should I make 168 different subs? Or continue to nest them?

VBA Code:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim bFound As Boolean

    Dim rCell As Range

    bFound = False

    'WEDNESDAY AM SERVER

   If Not Intersect(Target, Range("WED_AM_SER")) Is Nothing Then

    For Each rCell In Sheet2.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If

    Next rCell

    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If

   End If


   'WEDNESDAY PM SERVER

   If Not Intersect(Target, Range("WED_PM_SER")) Is Nothing Then

    For Each rCell In Sheet2.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If

    Next rCell

    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If

   End If


Original thread and full explanation CAN BE FOUND HERE
 
Sort by date Sort by votes
rlv01:
I haven't attempted the code in its entirety. I wasn't sure what the best route would be to incorporate the 196 subs. But I will try and followup here
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Worse yet logic is effed up. See below.

VBA Code: 
Option Explicit  '<= good practice to use this so varibles must be declared before they are used.

'Assumes existence of four ranges in the worksheet: AM_Staff, PM_Staff,
'AM_Availability and PM_Availability.
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim sAvailabilityRangeName As String
    
    sAvailabilityRangeName = ""
    
    If Not Intersect(Target, Range("AM_Staff")) Is Nothing _
     Then
        sAvailabilityRangeName = "AM_Availability"
    ElseIf Not Intersect(Target, Range("PM_Staff")) Is Nothing _
     Then
        sAvailabilityRangeName = "PM_Availability"
    End If
            
    If sAvailabilityRangeName <> "" Then Call CheckConflict(Target, sAvailabilityRangeName)
        
End Sub


Private Sub CheckConflict(prUserCell As Range, psAvaiabilityRangeName As String)

    Dim bFound As Boolean
    
    Dim rCell As Range
    
    bFound = False
    
    For Each rCell In Me.Range(psAvaiabilityRangeName)
    
        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If

End Sub
 
Upvote 0
Also,

The code below handles all days, shifts, & departments and DOES (technically) work 100%, but as expected, it chews up way too many resources. After working with it for a few minutes, excel was freezing intermittently and ultimatley crashed with an "Out of Memory" warning. I turned off all add-ons, and it seems to run "better", but I have a fairly capable rig. I am sharing this workbook with collegues who may have less capable computers, so I am trying to make this as lean as possible.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

 Dim bFound As Boolean
    
    Dim rCell As Range
    
    bFound = False
 
 
 
 'WEDNESDAY AM SERVER
    
   If Not Intersect(Target, Range("WED_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'WEDNESDAY PM SERVER
   
   If Not Intersect(Target, Range("WED_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   'THURSDAY AM SERVER
    
   If Not Intersect(Target, Range("THU_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'THURSDAY PM SERVER
   
   If Not Intersect(Target, Range("THU_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'FRIDAY AM SERVER
    
   If Not Intersect(Target, Range("FRI_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'FRIDAY PM SERVER
   
   If Not Intersect(Target, Range("FRI_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SATURDAY AM SERVER
    
   If Not Intersect(Target, Range("SAT_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SATURDAY PM SERVER
   
   If Not Intersect(Target, Range("SAT_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SUNDAY AM SERVER
    
   If Not Intersect(Target, Range("SUN_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SUNDAY PM SERVER
   
   If Not Intersect(Target, Range("SUN_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'MONDAY AM SERVER
    
   If Not Intersect(Target, Range("MON_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'MONDAY PM SERVER
   
   If Not Intersect(Target, Range("MON_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'TUESDAY AM SERVER
    
   If Not Intersect(Target, Range("TUE_AM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'TUESDAY PM SERVER
   
   If Not Intersect(Target, Range("TUE_PM_SER")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   
   '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   
   
   
   'WEDNESDAY AM SERVERb
    
   If Not Intersect(Target, Range("WED_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'WEDNESDAY PM SERVERb
   
   If Not Intersect(Target, Range("WED_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   'THURSDAY AM SERVERb
    
   If Not Intersect(Target, Range("THU_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'THURSDAY PM SERVERb
   
   If Not Intersect(Target, Range("THU_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'FRIDAY AM SERVERb
    
   If Not Intersect(Target, Range("FRI_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'FRIDAY PM SERVERb
   
   If Not Intersect(Target, Range("FRI_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SATURDAY AM SERVERb
    
   If Not Intersect(Target, Range("SAT_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SATURDAY PM SERVERb
   
   If Not Intersect(Target, Range("SAT_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SUNDAY AM SERVERb
    
   If Not Intersect(Target, Range("SUN_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SUNDAY PM SERVERb
   
   If Not Intersect(Target, Range("SUN_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'MONDAY AM SERVERb
    
   If Not Intersect(Target, Range("MON_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'MONDAY PM SERVERb
   
   If Not Intersect(Target, Range("MON_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'TUESDAY AM SERVERb
    
   If Not Intersect(Target, Range("TUE_AM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'TUESDAY PM SERVERb
   
   If Not Intersect(Target, Range("TUE_PM_SERb")) Is Nothing Then
        
    For Each rCell In Sheet2.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   '*************************************************************************************************
   'BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER
   '*************************************************************************************************
      'WEDNESDAY AM BUS
    
   If Not Intersect(Target, Range("WED_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'WEDNESDAY PM BUS
   
   If Not Intersect(Target, Range("WED_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   'THURSDAY AM BUS
    
   If Not Intersect(Target, Range("THU_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'THURSDAY PM BUS
   
   If Not Intersect(Target, Range("THU_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'FRIDAY AM BUS
    
   If Not Intersect(Target, Range("FRI_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'FRIDAY PM BUS
   
   If Not Intersect(Target, Range("FRI_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SATURDAY AM BUS
    
   If Not Intersect(Target, Range("SAT_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SATURDAY PM BUS
   
   If Not Intersect(Target, Range("SAT_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SUNDAY AM BUS
    
   If Not Intersect(Target, Range("SUN_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SUNDAY PM BUS
   
   If Not Intersect(Target, Range("SUN_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'MONDAY AM BUS
    
   If Not Intersect(Target, Range("MON_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'MONDAY PM BUS
   
   If Not Intersect(Target, Range("MON_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'TUESDAY AM BUS
    
   If Not Intersect(Target, Range("TUE_AM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'TUESDAY PM BUS
   
   If Not Intersect(Target, Range("TUE_PM_BUS")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   
   '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   
   
   
   'WEDNESDAY AM BUSb
    
   If Not Intersect(Target, Range("WED_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'WEDNESDAY PM BUSb
   
   If Not Intersect(Target, Range("WED_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   'THURSDAY AM BUSb
    
   If Not Intersect(Target, Range("THU_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'THURSDAY PM BUSb
   
   If Not Intersect(Target, Range("THU_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'FRIDAY AM BUSb
    
   If Not Intersect(Target, Range("FRI_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'FRIDAY PM BUSb
   
   If Not Intersect(Target, Range("FRI_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SATURDAY AM BUSb
    
   If Not Intersect(Target, Range("SAT_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SATURDAY PM BUSb
   
   If Not Intersect(Target, Range("SAT_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'SUNDAY AM BUSb
    
   If Not Intersect(Target, Range("SUN_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'SUNDAY PM BUSb
   
   If Not Intersect(Target, Range("SUN_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'MONDAY AM BUSb
    
   If Not Intersect(Target, Range("MON_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
        Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'MONDAY PM BUSb
   
   If Not Intersect(Target, Range("MON_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
    'TUESDAY AM BUSb
    
   If Not Intersect(Target, Range("TUE_AM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   
   
   'TUESDAY PM BUSb
   
   If Not Intersect(Target, Range("TUE_PM_BUSb")) Is Nothing Then
        
    For Each rCell In Sheet4.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
        
    Next rCell
        
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
    
   End If
   


End Sub
 
Upvote 0
rcicconetti said:
Also,

The code below handles all days, shifts, & departments and DOES (technically) work 100%, but as expected, it chews up way too many resources. After working with it for a few minutes, excel was freezing intermittently and ultimatley crashed with an "Out of Memory" warning. I turned off all add-ons, and it seems to run "better", but I have a fairly capable rig. I am sharing this workbook with collegues who may have less capable computers, so I am trying to make this as lean as possible.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

 Dim bFound As Boolean
   
    Dim rCell As Range
   
    bFound = False
 
 
 
 'WEDNESDAY AM SERVER
   
   If Not Intersect(Target, Range("WED_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'WEDNESDAY PM SERVER
  
   If Not Intersect(Target, Range("WED_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
   'THURSDAY AM SERVER
   
   If Not Intersect(Target, Range("THU_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'THURSDAY PM SERVER
  
   If Not Intersect(Target, Range("THU_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'FRIDAY AM SERVER
   
   If Not Intersect(Target, Range("FRI_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'FRIDAY PM SERVER
  
   If Not Intersect(Target, Range("FRI_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SATURDAY AM SERVER
   
   If Not Intersect(Target, Range("SAT_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SATURDAY PM SERVER
  
   If Not Intersect(Target, Range("SAT_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SUNDAY AM SERVER
   
   If Not Intersect(Target, Range("SUN_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SUNDAY PM SERVER
  
   If Not Intersect(Target, Range("SUN_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'MONDAY AM SERVER
   
   If Not Intersect(Target, Range("MON_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'MONDAY PM SERVER
  
   If Not Intersect(Target, Range("MON_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'TUESDAY AM SERVER
   
   If Not Intersect(Target, Range("TUE_AM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'TUESDAY PM SERVER
  
   If Not Intersect(Target, Range("TUE_PM_SER")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
  
   '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  
  
   'WEDNESDAY AM SERVERb
   
   If Not Intersect(Target, Range("WED_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'WEDNESDAY PM SERVERb
  
   If Not Intersect(Target, Range("WED_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
   'THURSDAY AM SERVERb
   
   If Not Intersect(Target, Range("THU_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'THURSDAY PM SERVERb
  
   If Not Intersect(Target, Range("THU_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'FRIDAY AM SERVERb
   
   If Not Intersect(Target, Range("FRI_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'FRIDAY PM SERVERb
  
   If Not Intersect(Target, Range("FRI_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SATURDAY AM SERVERb
   
   If Not Intersect(Target, Range("SAT_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SATURDAY PM SERVERb
  
   If Not Intersect(Target, Range("SAT_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SUNDAY AM SERVERb
   
   If Not Intersect(Target, Range("SUN_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SUNDAY PM SERVERb
  
   If Not Intersect(Target, Range("SUN_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'MONDAY AM SERVERb
   
   If Not Intersect(Target, Range("MON_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'MONDAY PM SERVERb
  
   If Not Intersect(Target, Range("MON_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'TUESDAY AM SERVERb
   
   If Not Intersect(Target, Range("TUE_AM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'TUESDAY PM SERVERb
  
   If Not Intersect(Target, Range("TUE_PM_SERb")) Is Nothing Then
       
    For Each rCell In Sheet2.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
   '*************************************************************************************************
   'BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER BUSSER
   '*************************************************************************************************
      'WEDNESDAY AM BUS
   
   If Not Intersect(Target, Range("WED_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'WEDNESDAY PM BUS
  
   If Not Intersect(Target, Range("WED_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
   'THURSDAY AM BUS
   
   If Not Intersect(Target, Range("THU_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'THURSDAY PM BUS
  
   If Not Intersect(Target, Range("THU_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'FRIDAY AM BUS
   
   If Not Intersect(Target, Range("FRI_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'FRIDAY PM BUS
  
   If Not Intersect(Target, Range("FRI_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SATURDAY AM BUS
   
   If Not Intersect(Target, Range("SAT_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SATURDAY PM BUS
  
   If Not Intersect(Target, Range("SAT_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SUNDAY AM BUS
   
   If Not Intersect(Target, Range("SUN_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SUNDAY PM BUS
  
   If Not Intersect(Target, Range("SUN_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'MONDAY AM BUS
   
   If Not Intersect(Target, Range("MON_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'MONDAY PM BUS
  
   If Not Intersect(Target, Range("MON_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'TUESDAY AM BUS
   
   If Not Intersect(Target, Range("TUE_AM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'TUESDAY PM BUS
  
   If Not Intersect(Target, Range("TUE_PM_BUS")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
  
   '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  
  
   'WEDNESDAY AM BUSb
   
   If Not Intersect(Target, Range("WED_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("S11:S800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'WEDNESDAY PM BUSb
  
   If Not Intersect(Target, Range("WED_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("U11:U800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
   'THURSDAY AM BUSb
   
   If Not Intersect(Target, Range("THU_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("Z11:Z800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'THURSDAY PM BUSb
  
   If Not Intersect(Target, Range("THU_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AB11:AB800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'FRIDAY AM BUSb
   
   If Not Intersect(Target, Range("FRI_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AG11:AG800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'FRIDAY PM BUSb
  
   If Not Intersect(Target, Range("FRI_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AI11:AI800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SATURDAY AM BUSb
   
   If Not Intersect(Target, Range("SAT_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AN11:AN800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SATURDAY PM BUSb
  
   If Not Intersect(Target, Range("SAT_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AP11:AP800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'SUNDAY AM BUSb
   
   If Not Intersect(Target, Range("SUN_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AU11:AU800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'SUNDAY PM BUSb
  
   If Not Intersect(Target, Range("SUN_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("AW11:AW800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'MONDAY AM BUSb
   
   If Not Intersect(Target, Range("MON_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("E11:E800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
        Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'MONDAY PM BUSb
  
   If Not Intersect(Target, Range("MON_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("G11:G800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
    'TUESDAY AM BUSb
   
   If Not Intersect(Target, Range("TUE_AM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("L11:L800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  
  
   'TUESDAY PM BUSb
  
   If Not Intersect(Target, Range("TUE_PM_BUSb")) Is Nothing Then
       
    For Each rCell In Sheet4.Range("N11:N800") 'Me refers to the worksheet that the event macro is in.

        If Trim(rCell.Value) = Trim(Target.Value) _
         Then
            bFound = True
            Exit For
        End If
       
    Next rCell
       
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
   
   End If
  


End Sub
Click to expand...
I was wrong... This code only handles 2 departments. ugh!
 
Upvote 0
rcicconetti said:
Offthelip:

I tried the array code again with the break as you suggested. It works, but for some reason it is affecting cells outside the range.

Please take a look at this video.

www.dropbox.com

Array_Code_Residual_Effect.mp4

Shared with Dropbox
www.dropbox.com www.dropbox.com
Click to expand...
The code I wrote doesn't write anything back to the worksheet so it can't directly affect any cells, something else is causing that. The point about the code I showed you is that whenever you are checking values in cells using a loop it is always much faster to load all the cells into a variant array and then loop through the variant array. In view of the fact you have possibly 196 checks to do you really should try to implement an array solution, because otherwise your workbook is going to be very slow whenever you type anything into it. If you compare my code to the code you originally posted you can see how little I had to change to your code to do the same using variant arrays. All the solutions posted so far, ( from my brief check ) apart from mine are still looping through the cells, so will be very very slow if you ever get all 196 checks in there!! I can't really help with the solution but whatever your eventual solution this technique can make it faster
 
Upvote 0
I already suggested this but -- assuming the conflict messaging is pretty important which is likely -- reconsider creating separate department workbooks each with 14 day worksheets. That would get rid of the issue related to the overhead associated with the change event that must do so many checks.

You could still have a master listing of availability whose data is pulled into specific department/day worksheets without a lot of trouble, it seems. I even imagine using the worksheet activate event for a specific department/day to gather availability data "automatically" whenever the user activates a department/day schedule sheet. The event handler delay would be much less than what you are getting now.

And creating a schedule would involve processing all department workbooks to create a master list of staff for a given day.

Once you get one day sheet designed you could clone 13 more day sheets using the 1st one to create a department workbook. And once you get one department workbook set up THAT would be cloned too, one clone for each remaining department.

I understand why you want to consolidate. But doing the availability conflict testing is just not practical using the worksheet change event. And, having separate department/day sheets would be much less complicated/unwieldy for a user.
 
Upvote 0
OaklandJim:

I'm not opposed to having the seperate worksheets. The problem I ran into was that conditional formatting (which I need) doesn't seem to work between sheets... At least not using the front end.

I haven't tested using VBA for conditional formatting. Does it work with multiple sheets?


Reasoning: Many employees are cross-trained and the schedulers often share them. Many times it's on "early bird gets the worm" terms. So to prevent someone from being double-scheduled, I have the condition to change the fill and/or font color if a name is repeated in opposing ranges. I use the same process (with a different format scheme) to alert schedulers (and workers) when they have double shifts. I.e they are a Fry Cook in the AM and a Server in the PM.
 
Upvote 0
Without a better understanding of your data, workbook and operations, I'm at a loss to suggest another approach. Do departments share employees?

Although this is just thinking out loud...there may be a way to speed up detection of availability and scheduling conflicts by filling two arrays with staff -- available and already scheduled -- then checking for 1. availability then 2. scheduling conflicts based on name.

Another idea is that you have a list of names -- for a given position/shift -- that are both available and not scheduled. Lists are updated as user adds names. Use that list for the dropdown. That way there is no checking for conflicts. That is, allow user to only select from available and unscheduled staff.

This is in the weeds but you can specify a dynamically sized named range (e.g., with staff names) for the validation dropdown. I do that often when a list needed for a validation dropdown is changing.

I'll try to assist if those approaches seem interesting.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Help with worksheet_change
Replies
7
Views
471
rcicconetti
R
A
  • Question
Trying to get dynamic comments (threaded comments are preferred)
Replies
0
Views
538
Austinkane6690
A
Nuke_It_Newport
  • Question
Referencing Pivot Table Sourced From ActiveSheet?
Replies
4
Views
447
Nuke_It_Newport
Nuke_It_Newport
D
  • Question
Multiple VBA Private Sub Worksheet_Change(ByVal Target As Range)
Replies
4
Views
2K
Dan Swartz
D
A
  • Solved
Should Cell Validation Trap Null Entries?
Replies
8
Views
386
Ark68
A

Forum statistics

Threads
1,215,327
Messages
6,124,290
Members
449,149
Latest member
mwdbActuary

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top