Data and Time Picker in Excel

[elenakotanchyan]

Hello,

I used the code below to have date picker in every cell in range H6:H504. It work s well. However, it also has a time stamp along with the date. I was wondering if it is possible to only have date?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheet1.DTPicker1
.Height = 20
.Width = 20
If Not Intersect(Target, Range("A:A")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With
End Sub



Thank you!

 

[Joe4]

I don't see anything in your code that is setting any sort of time stamp. Do you have other VBA code that is doing that, maybe a "Worksheet_Change" event procedure in the ame module?

It looks like it is just linking the cell to your Date Picker. If it is that linked cell that is causing the issue, then I think you may need to configure that Date Picker itself, to only return date and not time.

 

[elenakotanchyan]

I don't see anything in your code that is setting any sort of time stamp. Do you have other VBA code that is doing that, maybe a "Worksheet_Change" event procedure in the ame module?

It looks like it is just linking the cell to your Date Picker. If it is that linked cell that is causing the issue, then I think you may need to configure that Date Picker itself, to only return date and not time.

Hi! This is my VBA code. It works fine but as I said, DTPicker shows the date stamp along with the date.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngPaste As Range
Dim UndoList As String
Dim rngValidate As Range
Dim cell As Range

' See if any cells in range E6:E504 were updated
Set rngPaste = Intersect(Range("E7:E504"), Target)

' See if any cells in column G were updated
Set rngValidate = Intersect(Columns("G:G"), Target)

' Check for paste action in range E7:E504
If Not rngPaste Is Nothing Then

' Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)

' See if last action was paste
If Left(UndoList, 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Application.CutCopyMode = False
MsgBox "You are not allowed to paste to range E7:E504"
End If
End If

'Check for validation in column G based on column E

If Not rngValidate Is Nothing Then
For Each cell In rngValidate
If cell.Value <> "" And cell.Offset(0, -2) = "" Then
Application.EnableEvents = False
cell.ClearContents
Application.EnableEvents = True
MsgBox "Please, make sure there is response in column E before providing response in column G ", _
vbOKOnly, "ENTRY ERROR!!!"
End If
Next cell
End If

Set rngCheck = Intersect(Range("E7:E504"), Target)
If Not rngCheck Is Nothing Then
For Each cell In rngCheck
If cell.Value = cell.Offset(o, 1).Value Then
Application.EnableEvents = False
cell.Value = ""
Application.EnableEvents = True
MsgBox "Cells in column E should be different from cells in column F.", -vbOKOnly
End If
Next cell
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myRange As Range
Set myRange = Me.Range("E7:E504")

If Application.Intersect(Target, myRange) Is Nothing Then
Application.CellDragAndDrop = True
Else
Application.CellDragAndDrop = False
End If


With Sheet5.DTPicker1
.Height = 20
.Width = 20
If Not Intersect(Target, Range("H7:H504")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With

End Sub

 

[Joe4]

Where did you get the Date Picker from?
You may just need to configure it a little differently.
See here: Insert a date picker - Microsoft Support

 

[elenakotanchyan]

Where did you get the Date Picker from?
You may just need to configure it a little differently.
See here: Insert a date picker - Microsoft Support

I use Microsoft Date and Time Picker Control 6.0 (SP6)

 

[Joe4]

OK, I am not familiar with that, as I have not used that. But we can edit it so that when a Date is selected and put in the range H7:H504, we remove any time component.
You can do this by adding this section of code right above the "End Sub" line in your "Worksheet_Change" procedure:

'Remove time piece from Date/Time picker
Set rngDate = Intersect(Range("H7:H504"), Target)
If Not rngDate Is Nothing Then
    For Each cell In rngDate
        Application.EnableEvents = False
        cell.Value = Int(cell.Value)
        Application.EnableEvents = True
    Next cell
End If

End Sub