VBA inputbox for date and time instead of just time

Question

I asked a question earlier on this format and I got a very helpfull answer. I asked to put a inputbox that askes for the time in after a value is added to a cell and got this code Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub 'abort if more than one cell was changed

'only run the code if a cell in column A was changed
If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
    'ask for time and write it 2 columns right of the target cell
    Target.Offset(ColumnOffset:=2).Value = AskForValidTime
End If
End Sub


Private Function AskForValidTime() As String
Dim IsValid As Boolean

Do Until IsValid
    Dim Result As Variant
    Result = Application.InputBox("Wat is de tijd dat het monster genomen is?" & vbNewLine & "Gebruik UU:MM" & vbNewLine & "Voorbeeld: 09:30", "Tijdnotatie")
    
    'test if time is a valid time with less than 24 hours and less than 60 minutes
    Dim SplitTime() As String
    SplitTime = Split(Result, ":")
    If UBound(SplitTime) = 1 Then
        If Val(SplitTime(0)) < 24 And Val(SplitTime(1)) < 60 Then
            IsValid = True
            AskForValidTime = Result
            Exit Do
        End If
    End If

    MsgBox "Een correcte tijdsnotatie is nodig om door te gaan. Klik op" & vbNewLine & "<Ok> om de tijd opnieuw in te vullen", vbOKOnly + vbExclamation, vbNullString
Loop
End Function

This code is working perfectly so far and now I am trying to make it ask for date and time and validate both. So far it is not working out yet, since the date I enter as DD-MM comes out of the inputbox as MM-DD. This is my adaptation of the code above and I hope someone can help me with it.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub 'abort if more than one cell was changed

'only run the code if a cell in column A was changed
If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
    'ask for time and write it 2 columns right of the target cell
    Target.Offset(ColumnOffset:=2).Value = AskForValidTime
End If
End Sub


Private Function AskForValidTime() As String
Dim IsValid As Boolean

Do Until IsValid
    Dim Result As Variant
    Result = Application.InputBox("Wat is de tijd dat het monster genomen is?" & vbNewLine & "Gebruik UU:MM" & vbNewLine & "Voorbeeld: 09:30", "Tijdnotatie")
    
    'test if time is a valid time with less than 24 hours and less than 60 minutes
    Dim SplitDatetime() As String
    Dim SplitTime() As String
    SplitDatetime = Split(Result)
    If UBound(SplitDatetime) = 1 Then
    SplitTime = Split(SplitDatetime(1), ":")
        If Val(SplitTime(0)) < 24 And Val(SplitTime(1)) < 60 And IsDate(SplitDatetime(0)) Then
            IsValid = True
            AskForValidTime = Result
            Exit Do
        End If
    End If

    MsgBox "Een correcte tijdsnotatie is nodig om door te gaan. Klik op" & vbNewLine & "<Ok> om de tijd opnieuw in te vullen", vbOKOnly + vbExclamation, vbNullString
Loop
End Function

Answer 1

I think you need a function like this that would check your date format based on your settings and return a string of the correct date.

Function DtFormatType(strDate As String) As String

Dim str1 As String
Dim str2 As String
Dim str3 As String


str1 = Left(strDate, InStr(strDate, "/") - 1)
str2 = Left(Mid(strDate, InStr(strDate, "/") + 1), InStr(Mid(strDate, InStr(strDate, "/") + 1), "/") - 1)
str3 = Mid(Mid(strDate, InStr(strDate, "/") + 1), InStr(Mid(strDate, InStr(strDate, "/") + 1), "/") + 1)

If Application.International(xlDateOrder) = 0 Then
    DtFormatType = str2 & "/" & str1 & "/" & str3
ElseIf Application.International(xlDateOrder) = 1 Then
    DtFormatType = str1 & "/" & str2 & "/" & str3
ElseIf Application.International(xlDateOrder) = 2 Then
    DtFormatType = str3 & "/" & str2 & "/" & str1
End If

End Function

You may just then parameterize the delimiters.

Answer 2

I suggest the following change

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Cells.Count > 1 Then Exit Sub 'abort if more than one cell was changed
    
    'only run the code if a cell in column A was changed
    If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
        Target.Offset(ColumnOffset:=2).NumberFormat = "DD-MM-YYYY hh:mm"
        Target.Offset(ColumnOffset:=2).Value = AskForValidDateTime
    End If
End Sub


Private Function AskForValidDateTime() As Date
    Dim IsValid As Boolean
    
    Do Until IsValid
        Dim Result As Variant
        Result = Application.InputBox("Wat is de tijd dat het monster genomen is?" & vbNewLine & "Gebruik UU:MM" & vbNewLine & "Voorbeeld: 09:30", "Tijdnotatie")
        
        
        Dim SplitDateTime() As String 'split date from time
        SplitDateTime = Split(Result, " ")
        If UBound(SplitDateTime) = 1 Then
            Dim SplitDate() As String
            'note the following code only works for dates entered in the format DD-MM-YYYY
            SplitDate = Split(SplitDateTime(0), "-")
            If UBound(SplitDate) = 2 Then
                Dim SplitTime() As String
                SplitTime = Split(SplitDateTime(1), ":")
                If UBound(SplitTime) = 1 Then
                    If Val(SplitTime(0)) < 24 And Val(SplitTime(1)) < 60 Then
                        IsValid = True
                        'note the following code only works for dates entered in the format DD-MM-YYYY
                        AskForValidDateTime = DateSerial(Val(SplitDate(2)), Val(SplitDate(1)), Val(SplitDate(0))) + TimeSerial(Val(SplitTime(0)), Val(SplitTime(1)), 0)
                        Exit Do
                    End If
                End If
            End If
        End If
        
        MsgBox "Een correcte tijdsnotatie is nodig om door te gaan. Klik op" & vbNewLine & "<Ok> om de tijd opnieuw in te vullen", vbOKOnly + vbExclamation, vbNullString
    Loop
End Function