Calendar Control with some VB help required

[ArcticWolf]

Hi

Thanks to Ron for posting this code - very useful. I've put it into my
sheet and it
works perfect

I wonder if anyone could help modify it slightly for my needs please?

I have the calendar pop-up when a cell in column A (Date Order Received) is
selected.
In column B I need the user to put another date in (Date Order Shipped - and
I have used your calendar again) HOWEVER - this time (in B) I need some
'intelligence' so that the user cannot select a date which is less than the
date in A. B will always be >= A. Is there a way to modify the code so
column B doesn't return an earlier date than A?

Thanks in advance,

AW

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "dd/mmm/yyyy"
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("a3"), 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

 

[Bernie Deitrick]

AW,

This will allow any date in column B that is equal to later than the date in column A. It also will
not show the calendar control if column B is selected and column A is empty.

Private Sub Calendar1_Click()
If ActiveCell.Column = 2 Then
If Calendar1.Value < ActiveCell.Offset(0, -1).Value Then
MsgBox "Try to pick a date AFTER " & _
Format(ActiveCell.Offset(0, -1).Value - 1, "mmmm dd, yyyy")
Exit Sub
End If
End If
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "dd/mmm/yyyy"
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("A:B"), Target) Is Nothing Then
If Target.Column = 2 Then
If Target.Offset(0, -1).Value = "" Then Exit Sub
End If
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

HTH,
Bernie
MS Excel MVP

 

[ArcticWolf]

"Twinkle twinkle little star,
Bernie Deitrick that is what you are "

I changed the value to zero so that it returns in the error message box
(brilliant idea - thanks for adding this!!) the same as the date received.

Also, thanks for the swift reply - it's much appreciated.

ATB,

AW

 

[Bernie Deitrick]

Thanks for letting me know that you got this solution to work.

Bernie
MS Excel MVP