Populate a cell with a date using DatePicker

John1953

New Member
Joined
Aug 28, 2019
Messages
2
When I select a cell to add a date using DatePicker drop down box, I select a date but nothing displays in the selected cell. The code I used is;

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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
Hi John, welcome to the forum.

Try this

- Select cell on column A
- Select Date
- Or press Esc or any cell to hide dtpicker
- Or change date in the box and press Enter

Code:
Private Sub DTPicker1_Change()
  With Sheet1.DTPicker1
    ActiveCell.Value = .Value
    .Visible = False
    ActiveCell.Activate
  End With
End Sub


Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
    With Sheet1.DTPicker1
      ActiveCell.Value = .Value
      .Visible = False
      ActiveCell.Activate
    End With
  End If
End Sub


Private Sub DTPicker1_LostFocus()
  Sheet1.DTPicker1.Visible = False
End Sub


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

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
I can't answer your private message because your mailbox is full
 

John1953

New Member
Joined
Aug 28, 2019
Messages
2
DanteAmor

I entered your code as shown and it works great, however, if I select a row (row number on the left) I get the following message;
Run-Time error '1004';
Application-Defined or Object-Defined error

Any ideas?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
DanteAmor

I entered your code as shown and it works great, however, if I select a row (row number on the left) I get the following message;
Run-Time error '1004';
Application-Defined or Object-Defined error

Any ideas?
Try this, add line in red.

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[COLOR=#ff0000]if target.count > 1 then exit sub[/COLOR]
  If Not Intersect(Target, Range("A:A")) Is Nothing Then
    With Sheet1.DTPicker1
      .Visible = True
      .Top = Target.Top
      .Left = Target.Offset(0, 1).Left
    End With
  Else
    Sheet1.DTPicker1.Visible = False
  End If
End Sub
 

Forum statistics

Threads
1,081,574
Messages
5,359,707
Members
400,545
Latest member
Damntheman30

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top