Calendar Control with some VB help required
 

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

Calendar Control with some VB help required
 

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" wrote in message
...
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

Calendar Control with some VB help required
 

"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" wrote:

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" wrote in message
...
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

Calendar Control with some VB help required
 

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

Bernie
MS Excel MVP

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