Here you go
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r, c, u As Integer
r = Target.Row
c = Target.Column
u = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
If c > 1 Or r > u Or VBA.UCase(Range("F" & r)) <> "PENDING" Then Exit Sub
Dim Prompt As String
Dim Title As String
Dim strDate1 As String
Dim Date1 As Date
Prompt = "Enter date formatted: mm/dd/yyyy"
Title = "[Please Enter Date]"
strDate1 = InputBox(Prompt, Title)
On Error Resume Next
Date1 = CDate(strDate1)
If Err <> 0 Or strDate1 = "" Then
Exit Sub
End If
On Error GoTo 0
Target(1, 1).Value = VBA.Format(Date1, "mm/dd/yyyy")
End Sub
Bookmarks