Check Input for Valid Month

[SLW612]

Hello,
I am looking for a code that will automatically check an input box to make
sure the values entered are accurate. I don't know how to check to make sure
the month entered is the full name (and spelled correctly), and if not an
error message comes up to prompt for a correct entry. Thanks in advance!


Sub testdate()
Dim MyDate
Dim Message As String, Title As String
Dim current_date As String

MyDate = Format(Date, "mmmm yyy")

Message = "ENTER FULL MONTH AND YEAR FOR REPORT:"
Title = "Enter Date"
Default = MyDate
current_date = InputBox(Message, Title, Default)

Application.ScreenUpdating = False

With Sheets("Summary").Range("B2")
.NumberFormat = "mmmm yyy"
.Value = current_date
End With
Application.ScreenUpdating = True

End Sub

 

[SLW612]

Sorry, I just checked my code again (should have checked after editing and
before posting), and it is giving me a strange default year - "07267" instead
of 2007.

I also added "Default as String" because I forgot that too. SO my issues
now are DEFAULT YEAR coming out strange and needing to check validity for
MONTH.

Thanks!

 

[Bob Phillips]

Sub testdate()
Dim MyDate
Dim Message As String, Title As String
Dim current_date As String
Dim Default
Dim FirstDay As Date

MyDate = Format(Date, "mmmm yyyy")

Message = "ENTER FULL MONTH AND YEAR FOR REPORT:"
Title = "Enter Date"
Default = MyDate
current_date = InputBox(Message, Title, Default)
On Error Resume Next
FirstDay = DateValue("01 " & current_date)
On Error GoTo 0
If FirstDay <> 0 Then
Application.ScreenUpdating = False

With Sheets("Summary").Range("B2")
.NumberFormat = "mmmm yyy"
.Value = current_date
End With
Application.ScreenUpdating = True
Else

MsgBox "Invalid date"
End If

End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[SLW612]

Thanks for the quick reply Bob ...
But how do I get it to loop if the date entered is, in fact, invalid?

 

[Bob Phillips]

Sub testdate()
Dim MyDate
Dim Message As String, Title As String
Dim current_date As String
Dim Default
Dim FirstDay As Date

MyDate = Format(Date, "mmmm yyyy")

Do
Message = "ENTER FULL MONTH AND YEAR FOR REPORT:"
Title = "Enter Date"
Default = MyDate
current_date = InputBox(Message, Title, Default)
If current_date = "" Then
Exit Do
Else
On Error Resume Next
FirstDay = DateValue("01 " & current_date)
On Error GoTo 0
If FirstDay <> 0 Then
Application.ScreenUpdating = False

With Sheets("Summary").Range("B2")
.NumberFormat = "mmmm yyy"
.Value = current_date
End With
current_date = ""
Application.ScreenUpdating = True
Else

MsgBox "Invalid date"
End If
End If
Loop Until current_date = ""
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)