Check IF Input Date is Weekday, THEN ... ELSE ...

[JohnZ1156]

I'm looking for a simply macro to test if an Input date is a weekday or not.

Something Like:
If (Input date) is a Weekday, THEN

'Run this code

ELSE

'Run this code
End If

 

[Joe4]

I think it is somehow recognizing that our European friends default date format is day/month/year.

Try this variation which will check and make sure the first part does not exceed 12:

Sub CheckWeekday3()

    Dim inputDate As Variant
    Dim arr() As String

    inputDate = InputBox("Please enter the Date in mm/dd/yyyy format.", "Old Date", Date)
 
    If StrPtr(inputDate) = 0 Then Exit Sub
   
'   Check first part of date of entry (month)
    arr = Split(inputDate, "/")
    If arr(0) > 12 Then
        MsgBox "Invalid month entry of " & arr(0), vbOKOnly, "TRY AGAIN!"
        Exit Sub
    End If
 
    If Not IsDate(inputDate) Then
        MsgBox "That is not a valid date!", vbOKOnly, "TRY AGAIN!"
        Exit Sub
    End If

    If Weekday(inputDate, vbMonday) <= 5 Then
        ' Run code for weekday
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's a weekday! - " & inputDate
    Else
        ' Run code for weekend
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's not a weekday! - " & inputDate
    End If
 
End Sub

 

[JohnZ1156]

That make sense, those pesky Europeans.
But before, you could enter the date as either 4/25/2024 or 4-25-2024, and it worked!
Now, it will only accept dates if they use a "/" as the separator.

 

[Joe4]

OK, try this:

Sub CheckWeekday3()

    Dim inputDate As Variant
    Dim delim As String
    Dim arr() As String

    inputDate = InputBox("Please enter the Date", "Old Date", Date)
  
    If StrPtr(inputDate) = 0 Then Exit Sub
    
'   Find what is being used as the date delimiter
    If InStr(1, inputDate, "/") > 0 Then
        delim = "/"
    Else
        If InStr(1, inputDate, "-") > 0 Then
            delim = "-"
        End If
    End If
    
'   Check to see if they used "/" or "-" as a delimiter
    If delim = "" Then
        MsgBox "Please enter date in mm/dd/yyyy or mm-dd-yyyy format", vbOKOnly, "TRY AGAIN!"
        Exit Sub
    End If
    
'   Check first part of date of entry (month)
    arr = Split(inputDate, delim)
    If arr(0) > 12 Then
        MsgBox "Invalid month entry of " & arr(0), vbOKOnly, "TRY AGAIN!"
        Exit Sub
    End If
  
    If Not IsDate(inputDate) Then
        MsgBox "That is not a valid date!", vbOKOnly, "TRY AGAIN!"
        Exit Sub
    End If

    If Weekday(inputDate, vbMonday) <= 5 Then
        ' Run code for weekday
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's a weekday! - " & inputDate
    Else
        ' Run code for weekend
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's not a weekday! - " & inputDate
    End If
  
End Sub

Hopefully, there aren't any other monkey wrenches to toss into this process!

 

[JohnZ1156]

Great ! Thank you.
It's just that I have different people entering the data.

 

[Joe4]

Great ! Thank you.
It's just that I have different people entering the data.

You are welcome.

That is why in my previous post, I added this to the Input Box:

    inputDate = InputBox("Please enter the Date in mm/dd/yyyy format.", "Old Date", Date)

But I suppose we all know how well people actually read and follow instructions these days!

 

[Jaafar Tribak]

@JohnZ1156

My question is: If I'm entering the date as MM/DD/YYYY, why does it allow me to enter 13/1/2024 as a date? There is no 13th month?

Because 13/1/2024 is still a valid date. The vba IsDate function sees it as the 13th of Jan 2024.

13/1/2024 may not be in accordance with your default local system date format (mm/dd/yyy) which is what is causing the confusion.

In British English, dates are usually written in the order day – month – year, while in American English they are written month – day – year

Here is an alternative code which will only accept dates that are in accordance with the user's local date format.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
    Private Declare PtrSafe Function GetUserDefaultLCID Lib "kernel32" () As Long
#Else
    Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
    Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
#End If

Private Function GetSystemDateFormat() As String
    Const LOCALE_USER_DEFAULT = &H400, LOCALE_SSHORTDATE = &H1F
    Dim sBuffer As String * 128&, lRet As Long
    lRet = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, sBuffer, 128&)
    If lRet Then
        GetSystemDateFormat = Left$(sBuffer, lRet - 1&)
    End If
End Function


Sub CheckWeekday4()

    Dim inputDate As Variant, strFormat As String

    inputDate = InputBox("Please enter the Date.", "Old Date", Date)
  
    If StrPtr(inputDate) = 0 Then Exit Sub
  
    If Not IsDate(inputDate) Then
        GoTo ErrHandler
    End If
    
    inputDate = Replace(inputDate, "-", "/")
    
    inputDate = Right("00" & Split(inputDate, "/")(0), 2) & "/" & _
                Right("00" & Split(inputDate, "/")(1), 2) & "/" & _
                Split(inputDate, "/")(2)
                
    strFormat = GetSystemDateFormat
    
    If UCase(Left(strFormat, 1)) = "D" Then
        If Mid(inputDate, 4, 2) > 12 Then
            GoTo ErrHandler
        End If
    Else
        If UCase(Mid(inputDate, 1, 2)) > 12 Then
            GoTo ErrHandler
        End If
    End If

    If Weekday(inputDate, vbMonday) <= 5 Then
        ' Run code for weekday
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's a weekday! - " & inputDate
    Else
        ' Run code for weekend
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's not a weekday! - " & inputDate
    End If
    
    Exit Sub
    
ErrHandler:

    MsgBox "That is not a valid date!", vbOKOnly, "TRY AGAIN!"

End Sub

 

[Jaafar Tribak]

Sorry, I just saw Joe's answer which is working fine.
If you still want to restrict the date input according to the user's local date format then here is yet another improved version which also validates the "/" character and informs the user of the expected format.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
#Else
    Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
#End If

Private Function GetSystemDateFormat() As String
    Const LOCALE_USER_DEFAULT = &H400, LOCALE_SSHORTDATE = &H1F
    Dim sBuffer As String * 128&, lRet As Long
    lRet = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, sBuffer, 128&)
    If lRet Then
        GetSystemDateFormat = Left$(sBuffer, lRet - 1&)
    End If
End Function

Sub CheckWeekday()

    Dim inputDate As Variant, strFormat As String

    inputDate = InputBox("Please enter the Date.", "Old Date", Date)
  
    If StrPtr(inputDate) = 0 Then Exit Sub
    
    strFormat = GetSystemDateFormat
  
    If Not IsDate(inputDate) Then
        GoTo ErrHandler
    End If
    
    inputDate = Replace(inputDate, "-", "/")
    
    If InStr(inputDate, "/") = 0 Then GoTo ErrHandler
    
    inputDate = Right("00" & Split(inputDate, "/")(0), 2) & "/" & _
                Right("00" & Split(inputDate, "/")(1), 2) & "/" & _
                Split(inputDate, "/")(2)
    
    If UCase(Left(strFormat, 1)) = "D" Then
        If Mid(inputDate, 4, 2) > 12 Then
            GoTo ErrHandler
        End If
    Else
        If UCase(Mid(inputDate, 1, 2)) > 12 Then
            GoTo ErrHandler
        End If
    End If

    If Weekday(inputDate, vbMonday) <= 5 Then
        ' Run code for weekday
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's a weekday! - " & inputDate
    Else
        ' Run code for weekend
        Worksheets("Sheet1").Range("H3").Value = inputDate
        MsgBox "It's not a weekday! - " & inputDate
    End If
    
    Exit Sub
    
ErrHandler:

    MsgBox "Please enter date in " & LCase(strFormat) & " format", vbOKOnly, "TRY AGAIN!"

End Sub