vbaexcel-2019

Count days between two dates and activate mandatory input if result is “less than 4”?


I want to do VBA code as below.

  1. Cell J2 is set to today()
  2. Cell J4 can be set another date by user
  3. Cell L4 set a formula =NETWORKDAY(J2-J4)-1, to calculate the exact days between the dates in J2 & J4
  4. if the outcome in L4 is <4, user could continue to fill in the form;
  5. Otherwise, 2 msg box pop up in sequence
    • msgbox : 'Application takes at least 4-7 workings days';
    • msgbox : 'Please pick another date'
  6. return to Cell J4 which will be cleared as well
  7. User should input the date in J4 again

Here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Range("L4") >= 4 Then Exit Sub

Else

msg = MsgBox("Application takes at least 4-7 working days", vbOKOnly, "Reminder")

Range("J4").Select

Selection.ClearContents

msg = MsgBox("Please choose another date", vbOKOnly)

End If

End sub

enter image description here


Solution

  • First check to see if the Worksheet_Change Target is the date cell that the user is updating (J4). If it is, check L4 and pop your message box. Lastly turn events back on so it can trigger again next time there is a change.

    Private Sub Worksheet_Change(ByVal Target As Range)
        Application.EnableEvents = False
        If Not Intersect(Range("J4"), Target) Is Nothing Then:
            If Range("L4").Value < 4 Then
                 msg = MsgBox("Application takes at least 4-7 working days", vbOKOnly, "Reminder")
                 Range("J4").ClearContents
                 meg = MsgBox("Please choose another date", vbOKOnly)
            End If
        End If
        Application.EnableEvents = True
    End Sub