Filter the microsoft date and time picker control output

Hi

Firstly I am a complete novice at VBA. I have used the Microsoft date and time picker control output to input dates into a column. I want to be able to filter that column using the filter function at the top. However every time I try to filter I get a pop-up with "runtime error 440 Invalid code value". I assume its because I have set specific cell values in the VBA code and filtering changes these values. This is the code I have used:

Code:

---

Private Sub DTPicker21_CallbackKeyDown(ByVal  KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As  String, CallbackDate As Date)

End Sub

---

Code:

---

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  With Sheet1.DTPicker21
    .Height = 20
    .Width = 20
    If Not Intersect(Target, Range("G5:G3000,H5:H3000,I5:I3000")) 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

---

Any Help with this would be much appreciated.

Thanks

Can't reproduce that error here, but you could try adding the line:

Code:

---

If Target.Cells.Count <> 1 Then Exit Sub

---

straight after the 1st line (Private Sub Worksheet_SelectionChange(ByVal Target As Range)) to prevent a multiple-cell selection activating the DTPicker.

You can try, as the first lines of the Procedure

Code:

---

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("G5:I3000")) Is Nothing Then exit sub

---

Edit to add: Use the Worksheet_BeforeDoubleClick Event sub to eliminate the issue

Code:

---

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    if Intersect(Target, Range("G5:I3000")) Is Nothing then Exit Sub

    Cancel = True
    with Sheet1.DTPicker21
        .Height = 20
        .Width = 20
        .Visible = True
        .Top = Target.Top
        .Left = Target.Offset(0, 1).Left
        .LinkedCell = Target.Address
    end with
End Sub

---

Thanks for your quick reply. P45cal that worked perfectly. Thanks you so much.