Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TimeStr As String
If Target.Count > 1 Or Application.CountA(Target) = 0 Then Exit Sub
If Not Intersect(Target, Range("D3, F3, D16, F16, D29, F29, D42, F42, D55, F55, M3, O3, M16, O16, M29, O29, M42, O42, M55, O55")) Is Nothing Then
If Not Intersect(Target, Range("D3, F3, D16, F16, D29, F29, D42, F42, D55, F55, M3, O3, M16, O16, M29, O29, M42, O42, M55, O55")) Is Nothing Then On Error GoTo EndMacro
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End If
End Sub