Can(Should) this sub be shortened?

[rcicconetti]

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:

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

 

[offthelip]

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.

'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

this code is still very slow and can be improved by using the variant array technique that I posted rather than looping through each cell. In a workhseet change event this is very important

 

[OaklandJim]

Generating a "report" including schedules across seven workbooks and 14 days like you have now would not be trivial but is doable. Without knowing more -- or without more time to think it over -- it would also be doable to gather data from a master data workbook.

 

[offthelip]

[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?

The code I posted only excecutes one check on each worksheet change and it could be expanded to include any number of column without taking any more time. You code only gave two checks so I just "improved" those two checks. Note using variant array is usually about 1000 times faster than looping through the cells so to do this code 198 times is still about 10 times faster than your original code

 

[OaklandJim]

In the event handler you only determine which range user is in then call a sub that implements an adaptation of OffTheLip's suggested array approach to check availability. You'd feed Target from the event into that separate sub along with the range to look in for availability.

 

[rlv01]

Are you experiencing slowdown/performance issues with your current code? The only real reason to switch to an array approach is if you are. Otherwise what you have can just be tidied up a bit.

 

[rcicconetti]

offthelip:

I tried your array code, but it throws the msgbox every time.

 

[offthelip]

offthelip:

I tried your array code, but it throws the msgbox every time.

Put a break point in the sub where the logical check is i.r on this line:

If Trim(inarr(i, colno)) = ttrim Then

and check that the correct values are on both sides the if statement. look on LOCALS window and check that the valus inthe variant aray inarr are the ones you expect to check against. The logic shoudl be identical to the your code all i was doing was loading the worksheet into a Varaint array to do the checks, This is much much faster that checking each cell on a workhseet, Since you are calling this on every workhseet change it wi well worth using variant arrays becaus it will keep your worksheet super fast. Speed mioght not be a probelm now but it coudl be later and it is always worth learning how to keep your vBA fast , using variant arrays is the easiest way to write fast code

 

[OaklandJim]

This (approach shown below) will not reduce the number of "tests" needed to determine which day/shift/position is being processed but you could certainly have a separate sub that does the actual check for a conflict. That would make code a lot shorter.

My example below shows the CONCEPT of separating code for 1. determination of user range and 2. check for conflict. It uses my klunkier approach to check for a conflict but you could definitely use the more elegant/faster array approach instead. That said, the check for conflict should not take much time whichever approach is used (variant array or For Loop). The process of determining which which day/shift/position the user is changing WILL take a lot of time => screen may seem "jumpy" each time a different cell is chosen.

The example only does two checks. You'd need to do this for all possible user ranges.

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
    
    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
            
    Call CheckConflict(Target, sAvailabilityRangeName)
        
End Sub


Private Sub CheckConflict(prUserCell As Range, psAvailabilityRangeName 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

 

[rlv01]

I'd probably consolidate it this way. Sub ScanRange could be re-written to use an array approach, if desired.
(not tested)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bFound As Boolean
    ScanRange Target, "MON_AM_SER", bFound            'MONDAY AM SERVER (Schedule A)
    ScanRange Target, "MON_PM_SER", bFound            'MONDAY PM SERVER (Schedule A)
    ScanRange Target, "TUE_AM_SER", bFound            'TUESDAY AM SERVER (Schedule A)
    ScanRange Target, "TUE_PM_SER", bFound            'TUESDAY PM SERVER (Schedule A)
    ScanRange Target, "WED_AM_SER", bFound            'WEDNESDAY AM SERVER (Schedule A)
    ScanRange Target, "WED_PM_SER", bFound            'WEDNESDAY PM SERVER (Schedule A)
    ScanRange Target, "THU_AM_SER", bFound            'THURSDAY AM SERVER (Schedule A)
    ScanRange Target, "THU_PM_SER", bFound            'THURSDAY PM SERVER (Schedule A)
    ScanRange Target, "FRI_AM_SER", bFound            'FRIDAY AM SERVER (Schedule A)
    ScanRange Target, "FRI_PM_SER", bFound            'FRIDAY PM SERVER (Schedule A)
    ScanRange Target, "SAT_AM_SER", bFound            'SATURDAY AM SERVER (Schedule A)
    ScanRange Target, "SAT_PM_SER", bFound            'SATURDAY PM SERVER (Schedule A)
    ScanRange Target, "SUN_AM_SER", bFound            'SUNDAY AM SERVER (Schedule A)
    ScanRange Target, "SUN_PM_SER", bFound            'SUNDAY PM SERVER (Schedule A)
End Sub

Private Sub ScanRange(Target As Range, RangeLabel As String, ByVal bFound As Boolean)
    Dim rCell As Range, CellRange As Range
    Dim S As String
    
    On Error Resume Next
    Set CellRange = Me.Range(RangeLabel)
    On Error Resume Next
    
    bFound = False
    If Not Intersect(Target, CellRange) Is Nothing Then
        S = Trim(Target.Value)
        For Each rCell In CellRange
            If Trim(rCell.Value) = S Then
                bFound = True
                Exit For
            End If
        Next rCell

        If Not bFound Then
            MsgBox "There is an AVAILABILITY CONFLICT with this Employee (" & S & ") for Schedule " & RangeLabel, vbCritical
        End If
    End If
End Sub

 

[OaklandJim]

There was a typo in my conflict checker sub. Target.Value should be prUserCell.Value