![]()
Private Sub Worksheet_Change(ByVal Target As Range) Const iDefaultDays As Integer = 84 Dim dtExpected As Date If Target.Column = 1 Then Application.EnableEvents = False Cells(Target.Row, 4).Value = Date + Time Application.EnableEvents = True Else If Target.Column = 12 Then Application.EnableEvents = False Cells(Target.Row, 16).Value = Date + Time Application.EnableEvents = True Else If Target.Column = 15 Then Application.EnableEvents = False Cells(Target.Row, 16).Value = Date + Time Application.EnableEvents = True End If End If End If On Error GoTo Terminate If Target.Cells.Count > 6 Or Target.Column <> 6 Then GoTo Terminate If Target.Value = "" Then Target.Offset(0, 2).ClearContents GoTo Terminate End If Application.EnableEvents = False If Not IsDate(Target.Value) Then MsgBox "Invalid value - please enter a date", vbExclamation + vbOKOnly Target.ClearContents Target.Select Else dtExpected = Target.Value + iDefaultDays If MsgBox("Expected delivery date: " & dtExpected & String(2, vbCr) & "Accept this date?", vbYesNo + vbQuestion) = vbNo Then dtExpected = InputBox("Manually enter expected delivery date", , dtExpected) End If Target.Offset(0, 2).Value = dtExpected End If Terminate: If Err Then Debug.Print "Error", Err.Number, Err.Description Err.Clear End If Application.EnableEvents = True End Sub
Bookmarks