VBA Future Dates Cannot Be Selected

Question

I want to modify this date picker so any date ahead of today’s date cannot be selected.  Can you help?

Public Sub PickDate()

Dim PickedDate As Date

  If ActiveCell.Row > 3 Then

   If obPosUpLeft.Value Then 'radiobutton in sheet 1: "UpperLeft" selected

    PickedDate = frmWMDatePicker.GetDate(, , Application.ActiveWindow.Left, ActiveWindow.Top + CommandBars("Ribbon").Height)

   Else 'radiobutton in sheet 1: "Centered" selected

    PickedDate = frmWMDatePicker.GetDate()

   End If

   If PickedDate > 0 Then ActiveCell = PickedDate

  End If

End Sub

Private Sub btPickDate_Click()

Dim posLeft As Long

Dim posTop As Long

Dim PickedDate As Date

  If obPosUpLeft.Value Then 'radiobutton in sheet 1: "UpperLeft" selected

    posLeft = Application.ActiveWindow.Left

    posTop = ActiveWindow.Top + CommandBars("Ribbon").Height

  End If

  PickedDate = frmWMDatePicker.GetDate(Range("StartDate"), Range("StartDate").Interior.Color, posLeft, posTop)

  If PickedDate > 0 Then Range("ResultDate") = PickedDate

End Sub

Private Sub btTestUserForm_Click()

 TestForm.Show

End Sub

Private Sub btDirectCall_Click()

 frmWMDatePicker.Show

End Sub

Answer 1

Hello William,

Unfortunately, I don't have any further troubleshooting to offer.

There are many knowledgeable users active on the forum and I hope that someone else can offer further insight into your issue.

Thanks IBHADIGHI

Answer 2

Hi IBHADIGHI, thanks for your help. It does not seem to be working.

Answer 3

Hello William,

I'm Ibhadighi and I'd happily help you with your question. In this forum, we are Microsoft consumers just like yourself.

You can modify the date picker to prevent users from selecting dates that are ahead of today’s date by adding a check to the PickedDate variable in your code. Here’s an example of how you can do this:

Public Sub PickDate() Dim PickedDate As Date If ActiveCell.Row > 3 Then If obPosUpLeft.Value Then 'radiobutton in sheet 1: "UpperLeft" selected PickedDate = frmWMDatePicker.GetDate(, , Application.ActiveWindow.Left, ActiveWindow.Top + CommandBars("Ribbon"). Height) Else 'radiobutton in sheet 1: "Centered" selected PickedDate = frmWMDatePicker.GetDate() End If If PickedDate > 0 And PickedDate <= Date Then ActiveCell = PickedDate End If End Sub

Private Sub btPickDate_Click() Dim posLeft As Long Dim posTop As Long Dim PickedDate As Date

If obPosUpLeft.Value Then 'radiobutton in sheet 1: "UpperLeft" selected posLeft = Application.ActiveWindow.Left posTop = ActiveWindow.Top + CommandBars("Ribbon"). Height End If

PickedDate = frmWMDatePicker.GetDate(Range("StartDate"), Range("StartDate"). Interior.Color, posLeft, posTop) If PickedDate > 0 And PickedDate <= Date Then Range("ResultDate") = PickedDate End Sub

Private Sub btTestUserForm_Click() TestForm.Show End Sub

Private Sub btDirectCall_Click() frmWMDatePicker.Show End Sub

In this modified version of your code, the PickedDate variable is checked to see if it is less than or equal to the current date (PickedDate <= Date). If this condition is true, the selected date is entered into the active cell or the ResultDate range. Otherwise, no action is taken.

Best Regards, IBHADIGHI