Calendar with restricted dates to select

**bjohnsonac** · 03-18-2009, 12:46 PM

Is there a way to have a calendar pop up when a particular cell is selected and only have Sunday dates as optional selections? Needs to be able to scroll by month.

Thanks! You all have been sooo helpful!

**MickG** · 03-18-2009, 01:19 PM

Hi, On your Toolbar Select, "View","Toolbars", "Control ToolBox", at the bottom of the menu , there is an icon (Looks like Hammer & Spanner) Icon Says "More Controls", Click this and Select Calendar from the list, Click sheet, Calendar Appears on sheet.

Right click youy sheet, Select "View Code", VB Window appears.
Paste Both the codes (in one) into the Window.
Close Window
When you click in sheet the Calendar should disappear and when you click cell "A1" it reappears.
The calendar Code tells you, when you click a Weekday or the Weekend.
You need to alter it to do what you want.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
    Calendar1.Visible = True
Else
    Calendar1.Visible = False
End If
End Sub
Private Sub Calendar1_Click()
If Not Weekday(Calendar1.Value) = 1 Xor Not _
    Weekday(Calendar1.Value) = 7 Then
    MsgBox "Do something"
Else
    MsgBox "You Selected a Week Day"
Exit Sub
End If
End Sub

Regards Mick

**bjohnsonac** · 03-18-2009, 02:58 PM

Thanks Mick! A couple questions...

Once they select a date, how do I ensure that cell gets populated with the date they select?
Is there a way to create a "STOP" if they try to click past the date selection?
The calendar shows up when I open the workbook, but not necessarily when I click on the specific cell "I4" - I need it to show up EVERYTIME they click on cell "I4" and force them to make a selection that is a Sunday date.

**MickG** · 03-19-2009, 05:46 AM

Hi, Sorry I misread your Thread.
This code will allow a Sunday Date to be selected which will be transferred, on selection to the Active cell.
If any oher Days are selected you will get an error message.
The Calendar will show when you click "I4", and disappear when you click "I1".
Change these addresses to suit you.
If the Calendar does not appear, Click "Alt + F11" to view the VB Editor window. On the Toolbar Click The "Green Triangle" to Ensure the Blue Suare to its left is Dark Blue. This is to ensure you are in "run mode".
Exit the editer & try again.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$I$4" Then
    Calendar1.Visible = True
ElseIf Target.Address = "$I$1" Then
    Calendar1.Visible = False
End If
End Sub
Private Sub Calendar1_Click()
Dim Msg As String
If Not Weekday(Calendar1.Value) = 1 Then
        Msg = MsgBox("You Selected a Week Day" & Chr(10) & "Please Try Again !!", vbExclamation)
Exit Sub
    Else
Selection = Calendar1.Value
End If
End Sub

Regards
Mick

**bjohnsonac** · 03-20-2009, 09:53 AM

Mick, I got most of it working now thanks to you! The only thing I can't get to work is having the calendar disappear once the user clicks off cell $I$4....ideally, once they enter a date, I would like for the cursor to automaticlly move to cell $A$5 and have the calendar disappear, but if they return to cell $I$4 at any time the calendar should re-appear....

Here is my current code:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$I$4" Then
    Calendar1.Visible = True
ElseIf Target.Address = "$A$5" Then
    Calendar1.Visible = False
End If
End Sub
Private Sub Calendar1_Click()
Dim Msg As String
If Not Weekday(Calendar1.Value) = 1 Then
        Msg = MsgBox("You Selected a Week Day" & Chr(10) & "Please Try Again !!", vbExclamation)
Exit Sub
    Else
    Range("$I$4").Select
Selection = Calendar1.Value
    
End If
End Sub

Thanks again for all your help! This thing is almost done now and I can then move onto my next project

**MickG** · 03-20-2009, 10:28 AM

Hi, Try this:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$I$4" Then
    Calendar1.Visible = True
End If
End Sub
Private Sub Calendar1_Click()
Dim Msg As String
If Not Weekday(Calendar1.Value) = 1 Then
        Msg = MsgBox("You Selected a Week Day" & Chr(10) & "Please Try Again !!", vbExclamation)
        Exit Sub
   Else
        Range("$I$4") = Calendar1.Value
        Calendar1.Visible = False
        Range("a5").Select
End If
End Sub

Regards Mick