InputBox to enter time, with validation

Question

I want when the user enters a value in a cell in column A an inputbox should pop up asking for the time. I want the output of that inputbox in column C in the same row as where the value was entered in column A. I want this to happen every time something is entered in A.

• If A1 is filled, then time is asked and put into C1.
• If then A4 is filled, then time is asked and put into C4.

I also want if the time is not entered or not entered correctly (hh:mm), then a messagebox that says the time is not correctly entered then loop back to the inputbox.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim xRtn As Variant
    
    Set KeyCells = Range("A1:A100")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then    
        Do Until Not xRtn = 0 Or Format(xRtn, "hh:mm")
            xRtn = Application.InputBox("Wat is de tijd dat het monster genomen is?" & vbNewLine & "Gebruik UU:MM" & vbNewLine & "Voorbeeld: 09:30", "Tijdnotatie")
            Columns("C").Value = xRtn
            If xRtn = 0 Then
                If Not MsgBox("Een correcte tijdsnotatie is nodig om door te gaan. Klik op" & vbNewLine & "<Ok> om de tijd opnieuw in te vullen", vbOK + vbDefaultButton1 + vbExclamation, vbNullString) = vbOK Then
                End If
            End If
        Loop
    End If
End Sub

Answer 1

Something like below would do 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 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

But note that this forces the user to enter a valid time. If he doesn't he is not able to abort this action or get out of it.

I split the code for asking and validation into a seperate function AskForValidTime just in case you need to use the same thing somewhere else too. This way the code can easily be re-used.