Date picker cell

**donkey_uk** · 02-23-2018, 07:57 AM

HI Can anyone help

I have a workbook with a date picker in a few cells with code, all works perfect, however when I click on the cell I can input any data and when I click out of the cell it errors out.

if I click on the data picker dates its all ok.

What I would like to do is lock the cell so only a date from the date picker will be shown, or even a msb box saying input error please input correct date

Can anyone help me on theis. Here is the code that im using

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  With Sheet4.DTPicker2
    .Height = 20
    .Width = 20
    'If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If Not Application.Intersect(Range("b20,b23,d26,e26,e27,d27,b49,b51"), Target) 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

**kev_** · 02-23-2018, 08:35 AM

One trick I have employed to prevent the user being able to edit the cell directly:
- insert an active-x Label
- position it over the cell
- make it the same size as the cell
- make it transparent
- make it move and resize with the cell

Then to amend the cell value
- attach a click event macro to the Label which triggers your date picker

**kev_** · 02-23-2018, 09:07 AM

Here is a carrot for donkey

Attached is simple example of blocking direct edit of a cell
- the cell is named Cell_1 using a named range
- avoids risk of rows or columns being inserted and changing the cell reference
- a message pops up when user clicks on cell
(in fact user is clicking on transparent label)
- the event macro moves\sizes the label in line with the cell
(I would not necessarily trigger it by every SelectionChange event - but the code is useful and the label must move when rows are inserted etc)

The protected cell in the attached workbook is cell D2

Private Sub Label1_Click()
    MsgBox "You cannot edit this cell directly"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim shp1 As Shape:  Set shp1 = Me.Shapes("label1")
    Dim Cell_1 As Range:  Set Cell_1 = Range("Cell_1")
    With shp1
        .Top = Cell_1.Top
        .Left = Cell_1.Left
        .Height = Cell_1.Height
        .Width = Cell_1.Width
    End With
End Sub