Applying pop up calendar to entire worksheet

[Guest]

I posted this question already but I think I put it into the wrong area.

I have put a pop up calendar into a spreadsheet that is being used by
several people at my office. I now need to add many new pages and I wondered
if anyone can tell me how to make the pop up calendar work in the same cells
in every worksheet in the workbook. I used the code from Ron's website as
follows:

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/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("I6:I600"), 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

 

[Ron de Bruin]

Hi Klee

You can insert a calendar in every worksheet you want and also copy the same code in each worksheet.

If you make a copy of the sheet it will also copy the event code and the control

 

[Guest]

Thanks Ron. I had actually tried that prior to posting but it didn't work.
Once I read you post and realized it should have worked, I ended up copying
the sheet into a new workbook then adding the calendar and coping the new
sheets. It worked great this time.

Thanks very much

 

[TechGuy]

I posted this question already but I think I put it into the wrong area.

I have put a pop upcalendarinto a spreadsheet that is being used by
several people at my office. I now need to add many new pages and I wondered
if anyone can tell me how to make the pop upcalendarwork in the same cells
in every worksheet in the workbook. I used the code from Ron's website as
follows:

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/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("I6:I600"), 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 theCalendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub

You may want to consider using a polished 3rd party solution. See
http://www.wincalendar.com/excel-calendar.html for a very useful Excel
pop-up calendar.
Sam