Restrict cell entry by date and add a message

In the attached file I have a list od dates. I would like to restrict someone using my workbook from entering a date prior to today.  If they select a date from the drop down that occurs prior to today I would like to have a message come up and state, "This Date is in the Past, Please choose another date" and not accept that change to the cell. I have mulltiple sheets and work books to do this to so the easiest way to duplicate with Minimum effort is requested.
Sample-File-Date.xls
LVL 1
SMP319Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

TracyVBA DeveloperCommented:
Try this:
Dim origValue As String

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Value < Now() Then
        MsgBox "This Date is in the Past, Please choose another date", vbOKOnly, "Invalid Date"
        Target.Value = origValue
    Else
    End If
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.EnableEvents = False
    origValue = Target.Value
    Application.EnableEvents = True

End Sub

Open in new window

Sample-File-Date-1-.xls
0
RichardSchollarCommented:
Hi

It doesn't provide a warning, but if you adjust your Allow: List from =$Q$2:$Q$12 to:

=INDEX($Q$2:$Q$12,MATCH(TODAY(),$Q$2:$Q$12,1)+NOT(ISNUMBER(MATCH(TODAY(),$Q$2:$Q$12,0)))):$Q$12

You will only get a lit of the valid dates in the dropdown (previous dates are excluded and don't appear).  If all the dates in the list Q2:Q12 are in the past, you cannot enter anything.

Would this work for you?  Please see attached.

Richard
Sample-File-Date.xls
0
SMP319Author Commented:
Code works initially, but I have a couple of questions.
1. If I highlight the cells I am gettng a Run time Error and then the code no longer works.
2. How do I define the cells I would like the code to work for. I have another workbook that I need to add this code to.
3. I am assuming I am adding this code to the worksheet.
0
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

SMP319Author Commented:
My last comment was for Broomee9.
0
TracyVBA DeveloperCommented:
OK, this is a little better.

This line restricts the message box to coming up only if Column B is the one being changed
If Target.Value < Now() And Target.Column = 2 Then 'Restricts to Column B

This will prevent the run time error when a range is selected
If InStr(1, Target.Address, ":") = 0 Then 'A range was not selected
Dim origValue As String

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Value < Now() And Target.Column = 2 Then 'Restricts to Column B
        MsgBox "This Date is in the Past, Please choose another date", vbOKOnly, "Invalid Date"
        Target.Value = origValue
    Else
    End If
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If InStr(1, Target.Address, ":") = 0 Then 'A range was not selected
        origValue = Target.Value
    Else
    End If
    Application.EnableEvents = True
End Sub

Open in new window

Sample-File-Date-v2.xls
0
RichardSchollarCommented:
If you want to use VBA then you don't need to hold the previous value in a variable:

Richard
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exit_here
If Target.Count > 1 Then Exit Sub
If Not Intersect([b2:b14], Target) Is Nothing Then  'change range where dates are being entered (ie where you have validation)
    If Target.Value < Date Then
        MsgBox "You can't enter a date before today!", vbCritical + vbOKOnly, "Warning!"
        With Application
            .EnableEvents = False
            .Undo
        End With
    End If
End If
exit_here:
    Application.EnableEvents = True
End Sub

Open in new window

0
SMP319Author Commented:
I have attached the file that I need to have this code work in, I think when it is added to the code that is already there it is causing an error message. I also changed  the restriction from Column B to Column A
Sample-Date---Error.xls
0
TracyVBA DeveloperCommented:
OK, a few things:
You just changed the comment to say from Column B to Column A, not the actual code (so this doesn't actually do anything.  Also, you have two worksheet_change events, that's no good, that's where you're getting the error from.

Try it with the attached changes.
Sample-Date---v3.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Development

From novice to tech pro — start learning today.