Force format of date in this code...can't get to work

[Caveman1964]

I have altered this many times. Need it to come back and tell user they didn't enter proper date format.
Currently it allows any text to be entered. I tried many things but at my wits end. I have used suggestions from other date format posts but can't get to quite fit in this.
Codes begins by searching for a number and when it finds it asks to enter date, if one is already there, it says so, if not it allows anything to be put in. would like message to say, "date has been entered" as well.
Any help from you gurus is appreciated.

Sub enterdateintrosurveysent()
Sheets("Do Not Alter").Unprotect "1"
Sheets("Data Collection").Unprotect "1"
Sheets("Complaint Entry").Unprotect "1"


'Modified 11/10/2018 6:23:29 PM EST
Application.ScreenUpdating = False
Dim JobNumber As String
Dim SearchRange As Range
Dim NewDate As String
Sheets("Data Collection").Activate
JobNumber = InputBox("Please enter a Complaint Number", "Company Complaint System")
If Len(JobNumber) < 1 Then msgbox "No Value entered": Exit Sub
Set SearchRange = Range("A:A").find(JobNumber)
If SearchRange Is Nothing Then msgbox "Job number not found", vbExclamation, "Not found": Exit Sub
If Cells(SearchRange.Row, 19).Value = "" Then
NewDate = InputBox("Please enter the date", "Date")
Cells(SearchRange.Row, 19).Value = NewDate
Else
msgbox "The Value " & JobNumber & " Already Exists"
End If
Sheets("Complaint Entry").Select
Application.ScreenUpdating = True
Sheets("Do Not Alter").Protect "1", True, True
Sheets("Data Collection").Protect "1", True, True
Sheets("Complaint Entry").Protect "1", True, True


End Sub

 

[NdNoviceHlp]

Maybe this will help...
https://www.mrexcel.com/forum/excel-questions/813293-vba-help-date-input-box-error-handling.html
Dave

 

[Caveman1964]

Thank you!

 

[dmt32]

Hi
In response to your duplicate post, Try this update to your code

Sub enterdateintrosurveysent()
    Dim NewDate As Date
    Dim GetInput(1 To 2) As Variant, JobNumber As Variant
    Dim SearchRange As Range
    Dim i As Integer
    Dim Prompt As String, Title As String, Default As String
    Dim Response As VbMsgBoxResult
    
    Set wsDataCollection = Worksheets("Data Collection")
    
    i = 1
    Do
'initialize Prompts & Titles
        Prompt = "Please enter " & Choose(i, " a Complaint Number", "New Date")
        Title = Choose(i, "Company Complaint System", "Enter Date")
        Default = Choose(i, "", Date)
'show inputbox
        GetInput(i) = InputBox(Prompt, Title, Default)
'cancel pressed
        If StrPtr(GetInput(i)) = 0 Then Exit Sub
'check data entered
        If Len(GetInput(i)) > 1 Then
search:
            If i = 1 Then
'search job number
                JobNumber = GetInput(i)
                Set SearchRange = wsDataCollection.Columns(1).Find(JobNumber, lookat:=xlWhole, LookIn:=xlValues)
                If Not SearchRange Is Nothing Then
'job number found & Column S already has date entered
                    If SearchRange.Offset(, 18).Value <> "" Then
'inform user
                        Response = MsgBox("The Value " & JobNumber & " Already Exists" & Chr(10) & _
                        "Do You Want To Exit Search?", 36, "Job Number Exists")
                        If Response = vbYes Then Exit Do
                    Else
'increment index counter
                        i = i + 1
                    End If
                Else
'job number not found
                    MsgBox JobNumber & Chr(10) & "Record Not Found", 48, "Not Found"
                End If

            ElseIf i = 2 Then
'check valid date entered
                If IsDate(GetInput(i)) Then
'coerce inputbox text to Date & pass to variable
                    NewDate = DateValue(GetInput(i))
'enter value to range
                    SearchRange.Offset(, 18).Value = NewDate
'inform user
                    MsgBox JobNumber & Chr(10) & "Record Updated", 48, "Record Updated"
                    i = i + 1
                Else
'invalid date entry
                    MsgBox "Invalid Date Entry.", 16, "Invalid Date"
                End If
            Else
            End If
        End If
        
    Loop Until i > 2
    
End Sub

Not fully tested but hopefully goes in right direction.

Dave

 

[Caveman1964]

DMT32 Thank You! This works like a charm. I so appreciate the help. I should have learned more basics before tackling such a project. I can say I have learned a lot!
This relieved some stress! Much appreciated....have a good day!

 

[dmt32]

DMT32 Thank You! This works like a charm. I so appreciate the help. I should have learned more basics before tackling such a project. I can say I have learned a lot!
This relieved some stress! Much appreciated....have a good day!

Your welcome - glad solution helped.

Many thanks for feedback

Dave