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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Certainly no need to repeat the code 168 times of mayb even have any code at all.

Why not have a summary worksheet for all of the 168, employees I take it, and use a COUNTIF formula to ascertain whether
there is an availability conflict or not.. Then you could do a filter of those where attention is needed.

Even better still, try to avoid the availability conflicts being entered in the first place.

Can you post an image of what your data looks like?

What version of Excel are you on?
 
Upvote 0
I was attempting to edit the original post, but my time expired:

I've added more details here

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 Week. - Servers, Wed-Tue, AM Shift & PM Shift

In reality, there are 7 departments (Servers, Bussers, Drivers, Pizza Makers, Fry Cooks, Call Center, & Maintenance). All departments have both AM and PM shifts 7 days a week. The schedulers are able to work on 2 weeks worth of schedules.

So the code below would need to be repeated 11 more times with slight variations that would address the different ranges.
Server Schedule A (7 days, AM & PM shifts)
Server Schedule B (7 days, AM & PM shifts)
Busser Schedule A (7 days, AM & PM shifts)
Busser Schedule B (7 days, AM & PM shifts) etc.

NOTE: To handle double scheduling, the workbook relies on several conditional formatting rules that do not work across different sheets. Therefore, 14 days of schedules are located on one sheet.

This is a screen shot of the complete schedule template (zoomed out). The top 14 are a shared schedule for 4 smaller departments, the bottom are shared by 2 larger departments.
www.dropbox.com

screenshot full schedule.PNG

Shared with Dropbox
www.dropbox.com www.dropbox.com

This is a screenshot of the 5 dept. daily schedule close up:
www.dropbox.com

multi-schedule1.PNG

Shared with Dropbox
www.dropbox.com www.dropbox.com

This is a screenshot of the 2 dept. daily schedule close up:
www.dropbox.com

multi-schedule2.PNG

Shared with Dropbox
www.dropbox.com www.dropbox.com

This is a screenshot of the Server Availability Data. This is where the "Sheet2" references are drawn from. The data validation for the Servers is B11:B800
(Each department has a sheet like this):
www.dropbox.com

server availability.PNG

Shared with Dropbox
www.dropbox.com www.dropbox.com


Should I make 7 different subs (One for each Department?)
Should it be 196 seperate subs (One for each shift [7dept*7days*2shifts*2schedules])?
Should I continue to nest them in the same sub?

Or is there a more efficient way to write this? (this is my assumtion)

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 (Schedule A)
    
   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 (Schedule A)
   
   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 (Schedule A)
    
   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 (Schedule A)
   
   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 (Schedule A)
    
   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 (Schedule A)
   
   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 (Schedule A)
    
   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 (Schedule A)
   
   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 (Schedule A)
    
   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 (Schedule A)
   
   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 (Schedule A)
    
   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 (Schedule A)
   
   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 (Schedule A)
    
   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 (Schedule A)
   
   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
   
   End Sub


Original thread and full explanation CAN BE FOUND HERE
 
Upvote 0
You can combine the code that you posted with two checks into a single check and speed up the code by a large factor by using a varaint array insted of looping through the cells which will be very slow if you do it 168 times:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bFound As Boolean
    Dim rCell As Range
    bFound = False
    'WEDNESDAY AM SERVER
   With Worksheets("Sheet2")
    inarr = .Range("S11:U800")
    ttrim = Trim(Target.Value)
    colno = 0
   If Not Intersect(Target, Range("WED_AM_SER")) Is Nothing Then
     colno = 1
   End If
   If Not Intersect(Target, Range("WED_PM_SER")) Is Nothing Then
     colno = 3
   End If
   If colno > 0 then
    For i = 1 To UBound(inarr, 1)
        If Trim(inarr(i, colno)) = ttrim Then
            bFound = True
            Exit For
        End If
    Next i
   End if
    End With
    If Not bFound _
     Then
        MsgBox "There is an AVAILABILITY CONFLICT with this Employee", vbCritical
    End If
End Sub
 
Upvote 0
Sorry if the original post was confusing.

The 168 subs (actually 196...I was missing a dept) refers to potentially writing seperate subs for each shift:
Server Schedule A, Wednesday AM
Server Schedule A, Wednesday PM
Server Schedule A, Thursday AM
Server Schedule A, Thursday PM
...and so on, for each department, for schedule A & schedule B. (I realize this is the least likely solution)


Why I allow the conflicts:

This is a large, young, seasonal staff. The schedule is based on their "general availability". In the event we someone is available on a day when typically they are not, I want the schedulers to be able to add them. I just don't want them to be added accidentally, hence the msgbox "heads-up".


The Server Availability sheet uses if(or(isnumber(search))) to filter each employee's availability from column C.
Here's a screenshot:
www.dropbox.com

if_or_isnumber_search.PNG

Shared with Dropbox
www.dropbox.com www.dropbox.com
The content on the Availability Sheets is referenced from a filtered master employee data sheet. I would love to share the actual Excel file for clarity, but some information is sensative.


With this clarification, does your idea of using CountIf as a resolution still seem like as option?

If I can explain further, please let me know.

I appreciate any assistance.
 
Upvote 0
One way to make THIS specific PART of the task easier would be to set up a workbook for each department. Within each department is a worksheet for each day (i.e., 14). That way you'd only need to check two shifts in each worksheet. These sheets should be "clonable" meaning that once you have one sheet designed you can make 14 of them (using the same range names) for a given workbook (1 - 7). Then clone the workbook, one for each department.

That eliminates another issue: when you do "a lot" of stuff with code in the Worksheet_Change event eventually you get "screen stuttering" as Excel is doing so much behind the scenes which takes time.
 
Upvote 0
Each worksheet would need four ranges: AM_Server, PM_Server, AM_Availability, and PM_Availability.
 
Upvote 0

[B][FONT=arial]Herakles[/FONT][/B] - I am using Office 365 for Business​

offthelip - Using your combination I would still be repeating the action 98 times, which is a huge improvement! If this is as trimmed down as it gets, would you suggest nesting the actions or writing 98 seperate subs?
 
Upvote 0
OaklandJim

That's an interesting idea, but at the end of the day, the printable, postable schedules are a printout of these "multi-schedules". This allows the entire company's daily schedule to be viewed on 2 pages.

The core data exists in one sheet which is actually a data query from another source.

With this idea, I would have to parse the information to seperate workbooks, then rejoin it.

Also, there are several employees who are cross-trained. They can (and will) be shared across departments. The conditional formatting alerts the schedulers if an employee exists in conflicting cells. I.e. Johhny is a Busser, but also works as a Fry Cook when needed. The Server Manager schedules him on a Wed morning. Later that day, the Kitchen Manager attempts to schedule Johnny for the same shift. The conditional formatting changes the fill and font colors to alert both managers that the employee is double scheduled. (ASIDE: The same concept is used to alert double scheduling across locations. As you'll see in the Server/Busser Schedule, there are seperate locations.)
 
Upvote 0
I'm older and have effed up logic faculties left but as I imagine it the way I suggested means that in a given workbook (one of seven) and in a given day within the respective workbook (one of 14) you'd only need two checks: 1. if user changed a cell in AM scheduling range then check AM availability, 2. if user changed a cell in PM scheduling range then check PM availability range.

And, you could "improve" the check if you were to break out server availability from busser availability you'd need four checks. Still very efficient.

Note that if you copy a sheet the event code is cloned too!

This UNTESTED code shows an example event code.

VBA Code: 
'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 bFound As Boolean
    
    Dim rCell As Range
    
    bFound = False
    
    Dim sAvailabilityRangeName As String
    
    If Not Intersect(Target, Range("AM_Staff")) Is Nothing _
     Then
        sAvailabilityRangeName = "AM_Availability"
    Else
        sAvailabilityRangeName = "PM_Availability"
    End If
            
    For Each rCell In Me.Range(sAvailabilityRangeName)
    
        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
You must log in or register to reply here.

Similar threads

S
  • Solved
Search for entered value in another tab
Replies
3
Views
119
skittlz
S
K
  • Question Question
How to shorten vba code without any problems
Replies
1
Views
278
kamranyd
K
R
  • Solved
Help with worksheet_change
Replies
7
Views
615
rcicconetti
R
A
  • Question Question
Trying to get dynamic comments (threaded comments are preferred)
Replies
0
Views
628
Austinkane6690
A
M
  • Question Question
Copied sheet code to new file and lost some functionality....not sure how/why
Replies
5
Views
90
MeaclH
M

Forum statistics

Threads
1,223,885
Messages
6,175,183
Members
452,615
Latest member
bogeys2birdies

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