Worksheet_Change Multiple distinct Ranges Military Time

[MikeHoyt]

I have the following code which works great for letting me enter time as four digits (0615) into Range B32:C40. (Which is a schedule)
Now I need to allow the same sort of data entry to multiple schedules (different ranges) throughout the same worksheet

My understanding it that I can only have one Worksheet_Change (ByVal Target as Excel.Range) per worksheet. I see examples on this site
of people entering IF/Else or Case statements to effect different ranges, but I don't have enough experience to know how to do that with
my existing code (copied from somebodies helpful answer years ago).

I will only have a maximum of 10 schedules, each with a range of perhaps 20 cells, so if the solution would involve a loop running through all
of them every time an entry is made into any of those cells (the action to be taken is identical) I don't think there would be a noticeable performance lag.

Let's say I want to perform the same action on additional ranges E32:F40, H50:J50, etc. But I do not want to apply to the entire B32:J50 as other cells will be labels and such
(Many thanks in advance!)

'Schedule 1 Military Time Entry
Private Sub Worksheet_Change_1(ByVal Target As Excel.Range)
Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("B32:C40")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If

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 Sub

 

[johnnyL]

How about something like:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    Dim TimeStr As String
'
    On Error GoTo EndMacro
    If Target.Cells.Count > 1 Or Target.Value = "" Then Exit Sub
'
    If Application.Intersect(Target, Range("B32:C40, E32:F40, H50:J50")) Is Nothing Then
        Exit Sub
    End If
'
    Application.EnableEvents = False
'
    With Target
        If .HasFormula = False Then
            Select Case Len(.Value)
                Case 1: TimeStr = "00:0" & .Value                                                       ' e.g., 1 = 00:01 AM
                Case 2: TimeStr = "00:" & .Value                                                        ' e.g., 12 = 00:12 AM
                Case 3: TimeStr = Left(.Value, 1) & ":" & Right(.Value, 2)                              ' e.g., 735 = 7:35 AM
                Case 4: TimeStr = Left(.Value, 2) & ":" & Right(.Value, 2)                              ' e.g., 1234 = 12:34
                Case 5: TimeStr = Left(.Value, 1) & ":" & Mid(.Value, 2, 2) & ":" & Right(.Value, 2)    ' e.g., 12345 = 1:23:45 NOT 12:03:45
                Case 6: TimeStr = Left(.Value, 2) & ":" & Mid(.Value, 3, 2) & ":" & Right(.Value, 2)    ' e.g., 123456 = 12:34:56
                Case Else
                    Err.Raise 0
            End Select
'
            .Value = TimeValue(TimeStr)
        End If
    End With
'
    Application.EnableEvents = True
    Exit Sub
'
EndMacro:
    Target.Value = ""
    Application.Goto Target
    Application.EnableEvents = True
    MsgBox "You did not enter a valid time"
End Sub

 

[MikeHoyt]

Thank you very much! That works great with the Start and End cells formatted as Time 13:30 and a Duration cell formatted as Custom [mm]

When I try copy/paste from any of the input cells (the Start and End times), or fill down for the duration column, Excel exits ungracefully. I suppose I could get the spreadsheet entirly built before creating the macro, but is there a way to edit the macro so it won't interfere with me doing other work in the sheet?

 

[johnnyL]

Not sure of what you are asking.

Start time, End time, duration column? You have not mentioned these terms previously, so I am not sure how to advise.
Excel exits ungracefully? Can you be more specific what you mean by that?

Please describe exactly what you are attempting to do, and what happens when you are making those attempts.

If you want to disable the code from automatically running while you do other stuff, you could just change the name of the subroutine temporarily and then change it back when you want it to be active again. Example: You could change 'Private Sub Worksheet_Change(ByVal Target As Range)' to something like 'Private Sub NoWorksheet_Change(ByVal Target As Range)'. Then when you want it to work again, just change the name back to what it was originally.

 

[MikeHoyt]

Sorry, will try to be more specific. i work for a School District. I have to add up how many minutes the kids are in class, given say 6 periods a day but periods can start at different times at different days of the week, so in effect 5 Bell Schedules (yeah, my first question was WTF too,,,,)

So each Bell Schedule consists of a Start, End (formatted as Time 1:30 PM), and Duration (format [mm]) column, and 6 rows. If I just enter the time in General format (7:30m 8:15) I can get the duration by simple subtraction. That breaks after noon though 2:45 to 3:30 is a negative number, not 45. It's also slow to enter the start and end times with colons, hence my preference for military time and the need to convert the just the start and end cells in different specified ranges, which your code does admirably.

When I type the start/end times into the Monday, everything works fine. But if I want to copy say Monday Period 1 to Wednesday (because it's only the afternoon periods that different on wednesdays) Excel freezes, then closes. The auto-recovered spreadsheet is exactly where I was when I tried to copy. "Ungraceful".

Worse comes to worse I can just enter the times with colons and calculate the duration in my head, but it has happened in the past that when I give the spreadsheet to the schools they do the math wrong and give themselves credit for longer periods then they actually teach (0830 to 0915 is not 50 minutes) and that creates a significant financial liability as we have to repay the state if the kids are not actually full time.
Thank you for your patience!

 

[johnnyL]

Ok, How about this:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    Dim TimeStr As String
'
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
'
    On Error GoTo EndMacro
'
    If Application.Intersect(Target, Range("B32:C40, E32:F40, H50:J50")) Is Nothing Then
        Exit Sub
    End If
'
    Application.EnableEvents = False
'
    With Target
        If .HasFormula = False Then
            Select Case Len(.Value)
                Case 1: TimeStr = "00:0" & .Value                                                       ' e.g., 1 = 00:01 AM
                Case 2: TimeStr = "00:" & .Value                                                        ' e.g., 12 = 00:12 AM
                Case 3: TimeStr = Left(.Value, 1) & ":" & Right(.Value, 2)                              ' e.g., 735 = 7:35 AM
                Case 4: TimeStr = Left(.Value, 2) & ":" & Right(.Value, 2)                              ' e.g., 1234 = 12:34
                Case 5: TimeStr = Left(.Value, 1) & ":" & Mid(.Value, 2, 2) & ":" & Right(.Value, 2)    ' e.g., 12345 = 1:23:45 NOT 12:03:45
                Case 6: TimeStr = Left(.Value, 2) & ":" & Mid(.Value, 3, 2) & ":" & Right(.Value, 2)    ' e.g., 123456 = 12:34:56
                Case Else
                    Err.Raise 0
            End Select
'
            .Value = TimeValue(TimeStr)
        End If
    End With
'
    Application.EnableEvents = True
    Exit Sub
'
EndMacro:
    Target.Value = ""
    Application.Goto Target
    Application.EnableEvents = True
    MsgBox "You did not enter a valid time"
End Sub

 

[MikeHoyt]

That lets me copy /paste, thank you, but it is no longer handling the post noon times. I changed your range as
If Application.Intersect(Target, Range("B3:C6, G3:H6"))

But an entry of 1400 in B6 comes up up as 12:00 AM with a cell value of 10/31/1903 12:00:00 AM

 

[johnnyL]

What formula are you using for the Duration column?

 

[johnnyL]

But an entry of 1400 in B6 comes up up as 12:00 AM with a cell value of 10/31/1903 12:00:00 AM

I can't duplicate that result. Comes up as 2:00:00 PM for me when 1400 is entered in B6.

 

[MikeHoyt]

Formula for duration is simply End time - start Time.

Formatting issues are tough. I'll try again