Data Validation on InputBox

[jrake40]

I would like to only allow the user to enter a date in the inputbox in the format of 'mm-dd-yyyy'. If they do not I want to send msgbox. Here is what I have, just am unsure of how to get the validation.

Sub Populate_Date()On Error GoTo NotValidInput
Dim myvalue As Date
myvalue = InputBox("Enter Date 'mm-dd-yyyy'", "Date Entry", Date)


Sheets("Inbox Alerts").Range("A1", "B1").Value = myvalue
Sheets("Alert Daily Data").Range("B1").Value = myvalue
Sheets("Alert Daily Data 2").Range("B1").Value = myvalue
Sheets("Alert Daily Data Calculations").Range("B1").Value = myvalue
Exit Sub


NotValidInput:
    MsgBox ("You did not enter a correct Date")


End Sub

 

[dmt32]

Hi,
see if this change to your code does what you want

Sub Populate_Date()
    Dim myvalue As Variant, wsnames As Variant
    Dim DateFormat As String
    Dim rng As Range
    Dim ws As Worksheet
    
'required date format
    DateFormat = "mm-dd-yyyy"
    
'worksheet names
    wsnames = Array("Inbox Alerts", "Alert Daily Data", _
        "Alert Daily Data 2", "Alert Daily Data Calculations")


On Error GoTo myerror
        
'display inputbox
    Do
        myvalue = InputBox("Enter Date " & DateFormat, "Date Entry", Format(Date, DateFormat))
'cancel pressed
        If StrPtr(myvalue) = 0 Then Exit Sub
'entry not valid date
        If Not IsDate(myvalue) Then MsgBox "You did not enter a correct Date", 16, "Invalid Input)"
    Loop Until IsDate(myvalue)
    
'convert string date to date
'DateValue recognizes the order for month, day, and year
'according to the Short Date format you specified for your system.
    myvalue = DateValue(myvalue)


'send myvalue to required worksheet range(s)
    For Each ws In Worksheets(wsnames)
        If ws.Name = wsnames(LBound(wsnames)) Then Set rng = ws.Range("A1", "B1") Else Set rng = ws.Range("B1")
        rng.Value = myvalue
        rng.NumberFormat = DateFormat
    Next ws
myerror:
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

 

[jrake40]

Thank you Dave! I have realized that I want to tweak the sending value to the worksheet ranges. Could you help me do the following:

Send myvalue

For this sheet it stays the same I want those two cells A1:B1 on "InboxAlerts"
For "Alert Daily Data" I want it to populate to the next open cell in row 1 of my sheet starting at B:1. Thus if B1 is populated it puts it in C1 and so on.
For "Alert Daily Data 2" I want the same to the next open cell in row 1 of my sheet starting at B:1. Thus if B1 is populated it puts it in C1 and so on.

 

[dmt32]

You try try this update & see if goes in right direction:

Sub Populate_Date()
    Dim myvalue As Variant, wsnames As Variant
    Dim DateFormat As String
    Dim rng As Range
    Dim ws As Worksheet
    
'required date format
    DateFormat = "mm-dd-yyyy"
    
'worksheet names
    wsnames = Array("Inbox Alerts", "Alert Daily Data", _
        "Alert Daily Data 2", "Alert Daily Data Calculations")


On Error GoTo myerror
        
'display inputbox
    Do
        myvalue = InputBox("Enter Date " & DateFormat, "Date Entry", Format(Date, DateFormat))
'cancel pressed
        If StrPtr(myvalue) = 0 Then Exit Sub
'entry not valid date
        If Not IsDate(myvalue) Then MsgBox "You did not enter a correct Date", 16, "Invalid Input)"
    Loop Until IsDate(myvalue)
    
'convert string date to date
'DateValue recognizes the order for month, day, and year
'according to the Short Date format you specified for your system.
    myvalue = DateValue(myvalue)


'send myvalue to required worksheet range(s)
    For Each ws In Worksheets(wsnames)
        If ws.Name = wsnames(LBound(wsnames)) Then
        Set rng = ws.Range("A1", "B1")
        ElseIf ws.Name < wsnames(UBound(wsnames)) Then
        Set rng = ws.Cells(1, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1)
        Else
        Set rng = ws.Range("B1")
        End If
        rng.Value = myvalue
        rng.NumberFormat = DateFormat
        Set rng = Nothing
    Next ws
    
myerror:
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave