Manipulating a Time Calculation

[BrianExcel]

The following code manipulates the user-entered value into # of minutes. So if the user types in 10 then the code adjusts it to 0:10. If they enter 30 it goes to 0:30. if they enter 65 then it goes to 1:05, and so on.

BUT, when the user value goes beyond 100 (as in 100 = 1 hour 40 minutes0, it changes. If I type in 100 instead of adjusting to 1:40 it just plugs in 1:00.

So my question is how do I adjust the following code to always take the # of minutes in an hour into consideration instead of what is currently happening?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal

    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("O:Q, S:U, W:Y, AA:AC, AE:AG")) Is Nothing Then Exit Sub
    
    With Target
        vVal = Format(.Value, "0000")
        If IsNumeric(vVal) And Len(vVal) = 4 Then
            Application.EnableEvents = False
            .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
            .NumberFormat = "[h]:mm"
        End If
    End With
    Application.EnableEvents = True
End Sub

 

[shg]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("O:Q, S:U, W:Y, AA:AC, AE:AG")) Is Nothing Then Exit Sub
 
    With Target
        If InStr(.Text, ":") = 0 And VarType(.Value) = vbDouble Then
            Application.EnableEvents = False
            .Value = .Value / 1440
            .NumberFormat = "[h]:mm"
        End If
    End With
    Application.EnableEvents = True
End Sub

That only works the first time you enter data into the cell ...

 

[BrianExcel]

This works perfectly!

Obviously the next logical question would be why only the first time? What can I do so it always calculates?

This is a great start, but users make mistakes...

 

[shg]

The fact that users make mistakes is a good reason not to do this at all; it kills Undo.

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Cells.Count > 1 Then Exit Sub
        If Intersect(.Cells, Me.Range("O:Q, S:U, W:Y, AA:AC, AE:AG")) Is Nothing Then Exit Sub
        If VarType(.Value2) <> vbDouble Then Exit Sub
 
        On Error GoTo Oops
        Application.EnableEvents = False
 
        If InStr(.Text, ":") Then
            .Value = (Int(24 * .Value) / 24 + Minute(.Value)) / 1440
        Else
            .Value = .Value / 1440
        End If
        
        .NumberFormat = "[h]:mm"
    End With
Oops:
    Application.EnableEvents = True
End Sub