[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 356
  • Last Modified:

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
0
SMP319
Asked:
SMP319
  • 3
  • 3
  • 2
1 Solution
 
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
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Featured Post

[Webinar] Improve your customer journey

A positive customer journey is important in attracting and retaining business. To improve this experience, you can use Google Maps APIs to increase checkout conversions, boost user engagement, and optimize order fulfillment. Learn how in this webinar presented by Dito.

  • 3
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now