Cell Conditions for Popup Calendar via VBA

[jm485]

I have discovered that conditions on a cell won't work if the date entered into the cell is selected from a Controls Tools bar calendar.

So I created a VBA code to try and have the conditions work another way.

What I am trying to accomplish is the date in cell I11 cannot be less than the value of the date in cell renamed date1. If I11 is less than the value an Error userform (frmError) will pop up that just has a text box on it stating an error has occured. When that form pops up cell I11 will be cleared so a new date can be entered.

Here is the code:

Private Sub SecondProcess(ByVal Target As Range)
If Not Intersect(Target, [I11]) Is Nothing And Target.Value < Range("date1").Value Then
frmError.Show
ActiveCell.Select
Selection.ClearContents
End If
End Sub

The code works up until the frmError pops up and then it won't close. The calendar also stays open but I can't select a new date. The calendar will close if the frmError doesn't pop up.

Here is my code for the frmError:

Private Sub Error_Click()
Unload Me
End Sub

Also, I don't know if this is a cause as well...once a date is selected and the calendar disappears I have to click out of the cell and back in again in order for the calendar to pop up again. So I don't know if the error form is stuck because the calendar is still showing the lesser date as being chosen because it hasn't really been reset.

Here is my code for calendar1 in case you need it:

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yy"
ActiveCell.Select
Calendar1.Visible = False
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("I11,I12,J11,J12"), Target) Is Nothing Then
       Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
       Calendar1.Top = Target.Top + Target.Height
       Calendar1.Visible = True
       ' select Today's date in the Calendar
       Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub

 

[AlphaFrog]

I have discovered that conditions on a cell won't work if the date entered into the cell is selected from a Controls Tools bar calendar.

I don't understand why that wouldn't work. I can get it to work for me, but I don't know what conditions you are using.


Why not have the calendar click event check if the selected calendar date is valid? And use a standard msgbox to display the error if needed.

Maybe something like this...

Private Sub Calendar1_Click()
    If ActiveCell.Address = "$I$11" And _
        Calendar1.Value < Range("Date1").Value Then
        
            Application.EnableEvents = False
               Calendar1.Value = Range("Date1").Value
            Application.EnableEvents = True
            
            MsgBox "Date selected can't be less than " & Format(Range("Date1"), "mm/dd/yy") & _
                    vbCr & vbCr & "Please select another date.", vbCritical, "Invalid Date Selection"
            Exit Sub
    End If
    
    ActiveCell.Value = Calendar1.Value
    ActiveCell.NumberFormat = "mm/dd/yy"
    Calendar1.Visible = False
    
End Sub

This only checks if the selected date for cell I11 is greater than Date1. You'll have to adjust the code for other cells if needed. I'm not sure I follow all your criteria.

 

[jm485]

First of all thank you for such a quick response!

Second, thank you, thank you for helping me figure this problem out! Your code worked exactly how I needed it to.

I wish I would have asked a week ago, it would have saved me so much stress!