VB Calendar, if date not within 12 weeks, then msgpop up

[GlenRogers]

I am very new to VB, and only know how to do a few things with it. I can get the calendar control to come up and the value selected on the calendar to show up in a certain cell.

If a user selects a date that is not within a certain 12 week range, I want a message to appear ("date not within 12 week program"), and the user can't select the date.

I am storing nutrition data from a certain date the user chooses and it is a 12 week program from the start date. I want to retrieve info from those 12 weeks but do not want them to be able to select data outside the 12 weeks.

 

[Sal Paradise]

How do you decide the start date and the 12-week range? Without that information, it's impossible to tell you how to write the code. Generally though, if you're able to pass the calendar value to a cell, then you can simply take that code (likely something like Range("A1") = Calendar1.Value) and have it run a check first. Like:

If Calendar1.Value > UpperLimit OR Calendar1.Value < LowerLimit Then
    MsgBox("date not within 12 week program")
    Calendar1.Value = ""
Else
    Range("A1") = Calendar1.Value
End If

 

[GlenRogers]

Thanks Sal. I am still getting an 'object required' error. I put your code in. I am just not sure where to put it. i have it on a command button.

Sorry for not making it clear. here goes: I have date data in column E. user clicks a button for the nutrition program start date, 12 weeks of days enter down column E after they choose that date. I have another button that selects Meal Date. If user clicks that button, it brings up information from a date within the 12 week program (column E). If the date is not within the 12 week, then error message.

Here is what I have so far for my button.


Private Sub CmdMealDay_Click()

' Displays the UserForm and calendar
Application.Goto reference:="R31C3"
frmcalendar.Show

If Calendar1.Value > upperlimit Or Calendar1.Value < lowerlimit Then
MsgBox ("date not within 12 week program")
Calendar1.Value = ""
Else
Range("c31") = Calendar1.Value
End If


End Sub

and here is what I used for my calendar code:


Private Sub cmdClose_Click()

' Close the UserForm
Unload Me
End Sub

Private Sub UserForm_Initialize()
' Check if active cell contains a date. If 'yes' show
' same date on calendar. If 'no' show today's date.
If IsDate(ActiveCell.Value) Then
Calendar1.Value = DateValue(ActiveCell.Value)
Else
Calendar1.Value = Date
End If
End Sub

Private Sub Calendar1_Click()
' Transfer date selected on calendar to active cell
' and close UserForm.
ActiveCell.Value = Calendar1.Value
Unload Me
End Sub

 

[GlenRogers]

Here is the formula I found that pastes my nutrition program start date as the first date in the 12 week program. I then just have the date+1 filled down for 12 weeks. I see there is a message box in this formula but can't get that to work if I take out the '.

Not sure what I'm doing wrong.


Private Sub CommandButton1_Click()



Dim lookfor As Variant
Dim Rng As Range
Application.Goto reference:="r7c4"
Selection.Copy
lookfor = Sheets("sheet2").Range("c3").Value
If Trim(lookfor) <> "" Then
With Sheets("sheet2").Range("e:e")
Set Rng = .Find(What:=lookfor, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(0, 3)

'Set Rng = .Find(What:=lookfor).Offset(0, 3)
ActiveSheet.Select


'Application.Goto reference:="r1c1"
' If Not Rng Is Nothing Then
Application.Goto Rng, True
' Else
' MsgBox "Date Does Not Exist In 12 Week Program Range"



Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.Goto reference:="R7c4"
Selection.Copy
lookfor = Sheets("sheet2").Range("c3").Value
If Trim(lookfor) <> "" Then
With Sheets("sheet2").Range("e:e")
Set Rng = .Find(What:=lookfor).Offset(0, 1)
ActiveSheet.Select
Application.Goto Rng, True
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Application.Goto reference:="R8C4"
Selection.Copy
lookfor = Sheets("sheet2").Range("c3").Value
If Trim(lookfor) <> "" Then
With Sheets("sheet2").Range("e:e")
Set Rng = .Find(What:=lookfor).Offset(0, 2)
ActiveSheet.Select
Application.Goto Rng, True
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.Goto reference:="R9C4"
Selection.Copy
lookfor = Sheets("sheet2").Range("c3").Value
If Trim(lookfor) <> "" Then
With Sheets("sheet2").Range("e:e")
Set Rng = .Find(What:=lookfor).Offset(0, 3)
ActiveSheet.Select
Application.Goto Rng, True
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False








Application.Goto reference:="r1c1"




End With
End If
End With
End If
End With
End If

End With
End If

End Sub

 

[Sal Paradise]

My code wasn't designed to be copy-pasted, you need to set the upper and lower limits yourself if you're to use them. Alternatively, you can do a find to see if the date selected exists in column E. It would be really helpful if you could post some data from your sheet, and the code in [code][/code] tags.

 

[GlenRogers]

Hi Sal... Thanks for the help man, and the patience with this. I am not sure what you mean by code /code format. sorry.

I am doing a nutrition database sheet. Protein, carbs, and fat are copied and pasted with my VB code in post #4.

Protein is in reference:= "r7c4"
Carbs are in "r8c4"
fat is in "r9c4"

I put each in the code in post #4, after all the Dim Look for as Variant.

Do you want me to email You my data sheet that I am working on?

 

[GlenRogers]

Oh, I found mr excel on youtube... Awesome. I can get the conditional formatting by using =not(iserror(match(c31,E7:E17,0)))

c31 = my date selected.
E7:E17 = range of dates

The conditional format works if the date is not included, but I would like to put that in an error message and the user shouldn't be able to select the date if it is not in the range.

 

[Sal Paradise]

Wrap your code in code tags.

This: [code]This[/code]

Becomes:

This

 

[GlenRogers]

First cmdmealdate is my calendar that selects a start date in cell C3. I have E7 =C3 and E7+1, E8+1,E9+1... filled down for about 10 more dates.

The second CmdMealDay is the issue. I only want to be able to choose from the range of dates in E7:E17.

 Private Sub Cmdmealdate_Click()
' Displays the UserForm and calendar
' Shortcuts should be made to this procedure
    Application.Goto reference:="R3C3"
    frmcalendar.Show
End Sub

Private Sub CmdMealDay_Click()
' Displays the UserForm and calendar
' Shortcuts should be made to this procedure
    Application.Goto reference:="R31C3"
    frmcalendar.Show
    

End Sub

Here is my calendar code

Private Sub cmdClose_Click()

' Close the UserForm
    Unload Me
End Sub

Private Sub UserForm_Initialize()
' Check if active cell contains a date. If 'yes' show
' same date on calendar. If 'no' show today's date.
    If IsDate(ActiveCell.Value) Then
        Calendar1.Value = DateValue(ActiveCell.Value)
    Else
        Calendar1.Value = Date
    End If
End Sub

Private Sub Calendar1_Click()
' Transfer date selected on calendar to active cell
' and close UserForm.
    ActiveCell.Value = Calendar1.Value
    Unload Me
End Sub

 

[Sal Paradise]

Try this:

It will look for the calendar value in E7:E17, and if it finds the date, it sets the cell value and ends. Otherwise it gives an error message.

Private Sub Calendar1_Click()
' Transfer date selected on calendar to active cell
' and close UserForm.
    If Not Range("E7:E16").Find(Calendar1.Value, LookIn:=xlValues) Is Nothing Then
        ActiveCell.Value = Calendar1.Value
        Unload Me
    Else
        MsgBox("Invalid Date. Please select another.")
    End If
End Sub