VBA event code to not run if selection within date range

[bh24524]

Hi, I have an event code below which is a portion in a larger code that triggers when a certain selection is made from a drop-down menu. That selection is "Unexcused Absence"

If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
                   Answer = MsgBox("Is this employee using a Multiple?", vbYesNo)
                            If Answer = vbYes Then
                                Target.Offset(, 1) = "Multiple"
                            End If
        End If

If Unexcused Absence is selected from the drop-down menu, a pop-up message asks if the employee is using a Multiple and if they click yes, it writes the word Multiple one cell to the right of that one. I am wondering if there is a simple code line I can put in that will make this event procedure not run if the Date is between and including 12/18 thru 12/31 of any given year. The date is always in Cell C6 of the sheet. There are two variables declared for a separate portion of the macro which i believe could be used here: Dim StartDate As Date, EndDate As Date.
StartDate = DateSerial(Year(d), 12, 18)
EndDate = DateSerial(Year(d), 12, 31)
Trying to keep the post concise so I hope this is enough info, but if more is needed, let me know. Thank you!

 

[bh24524]

Tried to edit above but was too late. The portion
StartDate = DateSerial(Year(d), 12, 18)
EndDate = DateSerial(Year(d), 12, 31)
d = DateValue([C6])

 

[MountainFog]

Untested, but could something like the following work?

If Range("C6") <= EndDate AND Range ("C6") >= StartDate Then Exit Sub

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) Then Exit Sub
    If Intersect(Range("E:E"), Target) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
        If MsgBox("Is this employee using a Multiple?", vbYesNo) = vbYes Then
            Target.Offset(, 1) = "Multiple"
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[bh24524]

I'll just paste the entire code just in case:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RestrictedRange As Range
Dim RestrictedEntries As Variant, x As Variant
Dim StartDate As Date, EndDate As Date
Dim Answer As VbMsgBoxResult
Const RestrictedAddress As String = "E16:E42,E66:E92"


'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
'Event code to restrict VD entries based on holiday date ranges and SD based on 12/18 thru 12/31 of current year ranges
RestrictedEntries = Array("SCK-Sick", "SS", _
                          "VAC-Split Vac Week", "VV") 'first line November; 2nd line (position 3 onwards) for the date cells

x = Application.Match(Target.Value, RestrictedEntries, 0)
If Not IsError(x) Then
    Set RestrictedRange = Range(RestrictedAddress)
    If Not Intersect(Target, RestrictedRange) Is Nothing Then
        If IsDate([C6]) Then
            d = DateValue([C6])
            If x >= 3 Then 'Vac-Split Vac Week onwards in RestrictedEntries uses the date cells
                If IsDate([M16]) And IsDate([N16]) Then
                    StartDate = DateValue([M16])
                    EndDate = DateValue([N16])
                End If
            Else
                'Since we're not bothered by the year, use the year of the date in C6
                StartDate = DateSerial(Year(d), 12, 18)
                EndDate = DateSerial(Year(d), 12, 31)
            End If
            If d >= StartDate And d <= EndDate Then
                MsgBox "'" & Target.Value & "' is not allowed between " & Format(StartDate, "mm/dd/yyyy") & " and " & Format(EndDate, "mm/dd/yyyy")
                Application.EnableEvents = False
                Target = ""
                Target.Activate
                Application.EnableEvents = True
            End If
        End If
    End If
End If
'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||


'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
'Event Code if selection of Unexcused Absence is selected
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
                   Answer = MsgBox("Is this employee using a Multiple?", vbYesNo)
                            If Answer = vbYes Then
                                Target.Offset(, 1) = "Multiple"
                            End If
        End If
        Application.EnableEvents = True
    End If
'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||


'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
'Event code if OTH-Other is selected
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "OTH-Other" And Target.Offset(, -1) <> "CAS" Then
                   Answer = MsgBox("Do you want to upgrade a premium or a janitor?", vbYesNo)
                            If Answer = vbYes Then
                                Target = "DT - Dept. Transfer"
                                MsgBox "Please specify in the explanation column what to upgrade and how much. i.e.-""Upgrade Cooler Rate - Entire Shift"""
                                Target.Offset(, 1).Select
                            End If
        End If
        Application.EnableEvents = True
    End If
'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
End Sub

As you can see, there are actually multiple event procedures running in this code. I only want the middle portion with the unexcused absence selection to not run if the date is 12/18 thru 12/31. The other portions would still need to run. How might I inject a line of code that only affects that specific section?

 

[MountainFog]

Just Wrap the whole section in an if Statement

'Event Code if selection of Unexcused Absence is selected
If Range("C6") <= EndDate AND Range ("C6") >= StartDate Then
     If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
                   Answer = MsgBox("Is this employee using a Multiple?", vbYesNo)
                            If Answer = vbYes Then
                                Target.Offset(, 1) = "Multiple"
                            End If
        End If
        Application.EnableEvents = True
    End If
End If

 

[mumps]

Did you see my suggestion in Post #4?
(modified)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("C6") <= DateSerial(Year(Date), 12, 18) And Range("C6") >= DateSerial(Year(Date), 12, 31) Then
        If Not Intersect(Range("E:E"), Target) Is Nothing Then
            Application.EnableEvents = False
            If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
                If MsgBox("Is this employee using a Multiple?", vbYesNo) = vbYes Then
                    Target.Offset(, 1) = "Multiple"
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[bh24524]

I tried both solutions above but I'm actually not getting a pop up now at all no matter what date is in C6. I would expect a pop-up outside of the range of 12/18 thru 12/31 but no pop up within that range.

 

[mumps]

You didn't mention anything about a pop-up until now. Change the message (in red) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("C6") <= DateSerial(Year(Date), 12, 18) And Range("C6") >= DateSerial(Year(Date), 12, 31) Then
        If Not Intersect(Range("E:E"), Target) Is Nothing Then
            Application.EnableEvents = False
            If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
                If MsgBox("Is this employee using a Multiple?", vbYesNo) = vbYes Then
                    Target.Offset(, 1) = "Multiple"
                End If
            End If
        End If
    Else
        MsgBox ("The date is not valid.")
    End If
    Application.EnableEvents = True
End Sub

 

[bh24524]

You didn't mention anything about a pop-up until now. Change the message (in red) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("C6") <= DateSerial(Year(Date), 12, 18) And Range("C6") >= DateSerial(Year(Date), 12, 31) Then
        If Not Intersect(Range("E:E"), Target) Is Nothing Then
            Application.EnableEvents = False
            If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
                If MsgBox("Is this employee using a Multiple?", vbYesNo) = vbYes Then
                    Target.Offset(, 1) = "Multiple"
                End If
            End If
        End If
    Else
        MsgBox ("The date is not valid.")
    End If
    Application.EnableEvents = True
End Sub

It's actually right below the code I had pasted in the first post. I had said in there that when I select "Unexcused Absence" from the drop-down menu, the message pops up. That's what I was referring to in the later post. What I want is for that message not to pop up if the date is between 12/18 and 12/31. I believe that would change your more recent code, no?