Link to home
Start Free TrialLog in
Avatar of SMP319
SMP319Flag for United States of America

asked on

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
Avatar of Tracy
Tracy
Flag of United States of America image

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
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
Avatar of SMP319

ASKER

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.
Avatar of SMP319

ASKER

My last comment was for Broomee9.
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
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

Avatar of SMP319

ASKER

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
ASKER CERTIFIED SOLUTION
Avatar of Tracy
Tracy
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial