Insert calender

[Tinee]

How do I select dates without typing a look up list. Can a calender be
embedded into a worksheet in two cells. ie a list with to & from dates.

 

[Ron de Bruin]

Hi Tinee

Try
http://www.rondebruin.nl/calendar.htm

 

[ArcticWolf]

Hi Ron,

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

I wonder if you 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

 

[Ron de Bruin]

Hi ArcticWolf

Try this

Private Sub Calendar1_Click()
If Range("A1").Value > CDbl(Calendar1.Value) Then
MsgBox "Please select another date"
Else
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
End If
End Sub

 

[Ron de Bruin]

Bad example from me (not tested good)

Do you use two cells or do you use
column A and B with this code

Let me know and I change the code and test it this time <g>

 

[ArcticWolf]

Hi Ron,

Thanks for getting back to me so prompt.

I use column a for the "Order Recieved Date" and column B for "Order Sent
Date." So it's two calendars really. I originally used the code across both
cells (as I wanted the calendar in both) which worked great but I was able to
enter a date in B that was less than A. So date in calendar B >= date in
calendar A.

Also, when I click on cell and reduce zoom it doesn't keep all of the
calendar (it trims it) but only a part of it. Is is possible to see the
whole of it even when zooming?

Many thanks,

AW

 

[Ron de Bruin]

Try this one

Private Sub Calendar1_Click()
If ActiveCell.Column = 2 Then
If ActiveCell.Offset(0, -1).Value <> "" Then
If ActiveCell.Offset(0, -1).Value > CDbl(Calendar1.Value) Then
MsgBox "Please select another date"
Else
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
End If
Else
MsgBox "Please Add a date in column a first"
End If
Else
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
End If
End Sub

 

[ArcticWolf]

Thanks Ron. Works perfect.

One last thing, any idea how to keep it from 'cropping' when you zoom to 75%.

Thanks,

Peter

 

[Ron de Bruin]

This is a bug in the control
If you play a lot with your zoom this is a problem

If you want to change it one time
Delete the control
Save the workbook
Change zoom
Add the control
Save the workbook