Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'*' Ændr klokkeslæt i ark 1
 Dim TimeStr As String

 On Error GoTo EndMacro
 If Intersect(Target, Sheets(1).Range("N9:O487, Q9:R487, T9:U487")) Is Nothing Then Exit Sub
 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:
ActiveCell.Offset(-1, 0).Select: Selection = ""
'Dialog Message
        QuestionToMessageBox = "   Ugyldig indtastning !" & vbNewLine & vbNewLine & "   Skriv altid klokkeslættet som et helt tal uden separator." & vbNewLine & "   1        =   00:01" & vbNewLine & "   12      =   00:12" & vbNewLine & "   123    =   01:23" & vbNewLine & "   1234  =   12:34"
'MsgBox Title
        YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbOKOnly + vbInformation, "Ugyldig indtastning")
        
ActiveSheet.Unprotect Password:="Bus"
ActiveCell.NumberFormat = "hh:mm"
ActiveSheet.Protect Password:="Bus"
Application.EnableEvents = True


'*'------------------------------------------------------------------------------------

'*' List Range i Fane Indtast vagter
If Intersect(Target, Range("AB9:AB48")) Is Nothing Then Exit Sub
Dim t, List
  For t = 9 To 48
    If Cells(t, "AB") <> "" Then List = List & "," & Cells(t, "AB")
  Next

'*' Range dropdown liste i Ændr vagter
  With Range("L9:L38,L43:L73,L78:L108,L113:L142,L147:L177,L182:L211,L216:L246,L251:L281,L286:L314,L319:L349,L354:L383,L388:L418,L423:L452,L457:L487").Validation ' tilføj selv flere ranges
    .Delete
    .Add xlValidateList, Formula1:=List
    .InCellDropdown = True
  End With


End Sub