How to stop weekend date input

[Apple08]

Hi everyone

I want to avoid users to input a weekend or holiday date in the cell B10. I have a range of holidays and named as 'Holiday'. If user input a date such as 25/12/2018, then the date will automatically change to a day before the holiday or weekend e.g. 24/12/2018

If this is not possible to do it in the same field, I would consider to let users to input date in cell B11, then B10 will automatically work out the workday before the weekend or holiday input in B11.

Any help would be appreciated.

Regards
Elsa

 

[PCL]

Is it only for cell B10 ?

 

[PCL]

If answer for previous comment is yes then try next code in sheet's code

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Const WdAdd As String = "B10"
Const HRgName  As String = "Holidays"
Dim F
    If (Target.Address <> Range(WdAdd).Address) Then Exit Sub
    Application.EnableEvents = False
        Range(HRgName).Select
        Set F = Range(HRgName).Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
        If (Not F Is Nothing) Then
            MsgBox (" This is an holidays ")
            Target = ""
            Application.EnableEvents = True
            Exit Sub
        End If
        If ((Weekday(Target, 1) = vbSaturday) Or _
            (Weekday(Target, 1) = vbSunday)) Then
            MsgBox (" This is a weekend ")
            Target = ""
            Application.EnableEvents = True
            Exit Sub
        End If
    
    Application.EnableEvents = True
End Sub

 

[MickG]

Try this:-
If the date you don't want I either in Range "Holiday" or are a
Saturday Or Sunday then the code should loop back for previous dates, until it find a date that is acceptable .

Private [COLOR=navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=navy]As[/COLOR] Range)
[COLOR=navy]Dim[/COLOR] Fd [COLOR=navy]As[/COLOR] Boolean, Dn [COLOR=navy]As[/COLOR] Range, Ray [COLOR=navy]As[/COLOR] Variant, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Application.EnableEvents = False
Ray = ActiveWorkbook.Names("Holiday").RefersToRange
[COLOR=navy]If[/COLOR] Target.Address(0, 0) = "B10" [COLOR=navy]Then[/COLOR]
    [COLOR=navy]If[/COLOR] IsDate(Target) [COLOR=navy]Then[/COLOR]
       [COLOR=navy]Do[/COLOR] Until n >= UBound(Ray, 1)
            [COLOR=navy]For[/COLOR] n = 1 To UBound(Ray)
               [COLOR=navy]If[/COLOR] Weekday(Target, 0) > 5 Or Target.Value = Ray(n, 1) [COLOR=navy]Then[/COLOR]
                 Range("b10").Value = DateAdd("d", -1, Range("b10"))
                 [COLOR=navy]Exit[/COLOR] For
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] n
       [COLOR=navy]Loop[/COLOR]
   [COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Apple08]

Thanks both. However I have tried both macros, and have input the date 06/10/2018 into cell B10 but nothing happened. I have updated the B11 to B10 in the second macro. I wonder I might have done something wrong?

 

[MickG]

Sorry I have re-read your code thinking you said "B11". I have now altered the code to show "B10".

Q() Have you got a named range "Holiday" with special dates in it ????

 

[PCL]

Is there a range name "Holidays" ?
Are you entering data in cell "B10" ??
Is it October 6th you put in ?

 

[Apple08]

Yes B10 is correct and I have a named range 'Holiday'. Indeed, I have updated your macros to B10 but nothing happened after I input a date 6/10/2018 which is a Saturday.

 

[Apple08]

Am I correct that I only have to paste in the code into Macro and then input a date in cell B10 for testing? I believe I don't have to run the macro manually? I have updated the 'Holidays' to 'Holiday' in both macros, however no response after inputting date in B10.

 

[PCL]

Update the name Holiday in the macro not Holidays
It works OK in the test file prepared ...!
You could put a check in the macro : write a "stop" then press F5 to continue
to see if the event happen

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Const WdAdd As String = "B10"
Const HRgName  As String = "Holiday"
Dim F
    If (Target.Address <> Range(WdAdd).Address) Then Exit Sub
    Application.EnableEvents = False
        Range(HRgName).Select
        Set F = Range(HRgName).Find(Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
        If (Not F Is Nothing) Then
            MsgBox (" This is an holidays ")
            Target = ""
            Application.EnableEvents = True
            Exit Sub
        End If
        If ((Weekday(Target, 1) = vbSaturday) Or _
            (Weekday(Target, 1) = vbSunday)) Then
            MsgBox (" This is a weekend ")
            Target = ""
            Application.EnableEvents = True
            Exit Sub
        End If
    
    Application.EnableEvents = True
End Sub