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!

 

[mumps]

In the most recent code, the message will pop up if the date is not between 12/18 and 12/31.

 

[bh24524]

Still not working. It gives the message "The Date is not valid" every time no matter what date is in C6 or what is selected from the drop-down menu. Is this happening because this is part of the larger code? I don't want the date is not valid message at all. I just want the existing message "Is this employee using a multiple" to appear if the Unexcused Absence Option is selected and the date range isn't between those dates

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
            If Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) 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]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
            If Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) 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

This one isn't working either but I noticed the line you have: IF Msg Boxetc. = vb yes

Is that maybe the problem? Because that portion of the code has IF the msg box appears, but there is now no line of code triggering that message box to show in the first place where in the original code I pasted, it does.

 

[mumps]

Is that maybe the problem?

This is not the problem. I tested the code in a dummy file and it worked properly. It would be easier to help if you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data .

 

[bh24524]

This is not the problem. I tested the code in a dummy file and it worked properly. It would be easier to help if you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data .

Unfortunately, those sites are blocked from our access list here at work. I'll try some screenshots and see if that helps. So with this portion of code:

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

I get this result:

That is no matter what date is in C6. However, if I replace my coding with:

If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
            If Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) 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

and then select Unexcused Absence, I get this:

No pop-up message.

Now when I change the date to to 12/18 with that same code, I get this:

Again, that message needs to trigger outside of 12/18 thru 12/31, not within it.

Does that help clarify any?

EDIT:
I changed the line of code to:
If NOT Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) Then.

and it is now working. Thank you for the help overall with the code. Just that one line was throwing it off.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
            If Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) Then
                '
            Else
                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]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Unexcused Absence" And Target.Offset(, -1) <> "CAS" Then
            If Range("C6") >= DateSerial(Year(Date), 12, 18) And Range("C6") <= DateSerial(Year(Date), 12, 31) Then
                '
            Else
                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

Ahh I like this one even better. With my revision, I was getting it to work on all dates BEFORE 12/18 but when I put in 1/1/24 as a test, it wasn't working. When I put your code here in though and test 1/1/24 it worked, so thank you very much sir!

 

[mumps]

You are very welcome.