Excel Calander code changes

[Josh Johansen]

Here is what I have for a popup calander that I can use to select the date.
What I would like to be able to do is when the calander pops up, that it is 4
or 5 cells higher because half is on top of a pivot table and its causing
distortion, and also I would like the calander to dissapear once a date has
been selected. what must I change in the code to do this? thanks!

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyy"
ActiveCell.Select
End Sub

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("F3"), 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]

Try this

Because you use one cell (F3) I use F1 as position


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("F3"), Target) Is Nothing Then
Calendar1.Left = Range("F1").Left
Calendar1.Top = Range("F1").Top
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub

 

[Josh Johansen]

Worked perfect! Thanks a ton!

Try this

Because you use one cell (F3) I use F1 as position


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("F3"), Target) Is Nothing Then
Calendar1.Left = Range("F1").Left
Calendar1.Top = Range("F1").Top
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub