Macro: Replace number with time, interpret AM/PM

[MartinS13X]

Dear MrExcel experts,

I'm trying to save my girlfriend, who is a manager at a warehouse for a non-profit organisation, some time with filling out the time sheets/logs for staff and volunteers.

She's not very good at converting AM/PM to 24H format which would basically fix our little "problem".
Excel is fine when you're in AM territory. (ie. 7:00 means 7:00 AM). Times in the afternoon are a bit more tricky, as, as far as I know, it isn't possible to format cells purely for PM. Requiring to type 3:00 p (or PM), which Excel then will interpret as 3:00 PM.

So, in my quest to speed up things I figured it should be possible for her to enter a "simple" number (Table row 3) and then have excel convert it to the proper time (table row 4).

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[TD="align: center"]I[/TD]
[TD="align: center"]J[/TD]
[TD="align: center"]K[/TD]
[TD="align: center"]L[/TD]
[TD="align: center"]M[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]Monday [/TD]
[TD="align: center"]Monday
[/TD]
[TD="align: center"]Tuesday [/TD]
[TD="align: center"]Tuesday [/TD]
[TD="align: center"]Wednesday[/TD]
[TD="align: center"]Wednesday[/TD]
[TD="align: center"]Thursday[/TD]
[TD="align: center"]Thursday[/TD]
[TD="align: center"]Friday [/TD]
[TD="align: center"]Friday[/TD]
[TD="align: center"]Week Total[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]In[/TD]
[TD="align: center"]Out[/TD]
[TD="align: center"]In[/TD]
[TD="align: center"]Out[/TD]
[TD="align: center"]In[/TD]
[TD="align: center"]Out[/TD]
[TD="align: center"]In[/TD]
[TD="align: center"]Out[/TD]
[TD="align: center"]In[/TD]
[TD="align: center"]Out[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]715[/TD]
[TD="align: center"]300[/TD]
[TD="align: center"]700[/TD]
[TD="align: center"]300[/TD]
[TD="align: center"]700[/TD]
[TD="align: center"]300[/TD]
[TD="align: center"]700[/TD]
[TD="align: center"]300[/TD]
[TD="align: center"]700[/TD]
[TD="align: center"]230[/TD]
[TD="align: center"]38:15[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]7:15 AM [/TD]
[TD="align: center"]3:00 PM[/TD]
[TD="align: center"]7:00 AM[/TD]
[TD="align: center"]3:00 PM[/TD]
[TD="align: center"]7:00 AM[/TD]
[TD="align: center"]3:00 PM[/TD]
[TD="align: center"]7:00 AM[/TD]
[TD="align: center"]3:00 PM[/TD]
[TD="align: center"]7:00 PM[/TD]
[TD="align: center"]2:30 PM[/TD]
[TD="align: center"]38:15[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

I found a macro on the WWW which does basically exactly what I want it to do, except it still doesn't make a distinction between AM and PM (when time isn't entered in 24H format). My macro skills are limited, usually I'm able to figure stuff out though and alter/edit so they work for me, but now it has me a bit stumped.

The weird thing is that the macro as is, seems to be working for the whole sheet instead of the range. Even when I change it to say ("C6:C28") it still changes times in other cells as well. I don't get it...

My end goal is to add multiple ranges, so time entered into columns:
C, E, G, I, K will be interpreted as AM
D, F, H, J, L will be interpreted as PM

Thanks in advance for any help.

Here is the macro:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String


On Error GoTo EndMacro
If Application.Intersect(Target, Range("C6:L28")) Is Nothing Then
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 3
            TimeStr = Left(.Value, 1) & ":" & _
            Right(.Value, 2)
        Case 4
            TimeStr = Left(.Value, 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

 

[My Aswer Is This]

I think you should tell your friend to enter times like this
9:25

Or

1:45

And this script will work:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  11/17/2018  12:09:56 AM  EST
If Not Intersect(Target, Range("C:L")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
With Target
    Select Case Target.Column
        Case 3, 5, 7, 9, 11
            .NumberFormat = "h:mm ""AM"""
        Case 4, 6, 8, 10, 12
            .NumberFormat = "h:mm ""PM"""
    End Select
End With
End If
End Sub

 

[My Aswer Is This]

I forgot about changing range to C6

Here try this:
But she must enter times like this 4:25
Not like 425

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  11/17/2018  12:20:43 AM  EST
If Not Intersect(Target, Range("C6:L28")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
With Target
    Select Case Target.Column
        Case 3, 5, 7, 9, 11
            .NumberFormat = "h:mm ""AM"""
        Case 4, 6, 8, 10, 12
            .NumberFormat = "h:mm ""PM"""
    End Select
End With
End If
End Sub

 

[MartinS13X]

I forgot about changing range to C6

Here try this:
But she must enter times like this 4:25
Not like 425

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  11/17/2018  12:20:43 AM  EST
If Not Intersect(Target, Range("C6:L28")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
With Target
    Select Case Target.Column
        Case 3, 5, 7, 9, 11
            .NumberFormat = "h:mm ""AM"""
        Case 4, 6, 8, 10, 12
            .NumberFormat = "h:mm ""PM"""
    End Select
End With
End If
End Sub

Thanks
Yes, that works.

I've learned some new things. Didn't know how about "case" and obviously didn't think about that .numberfomat. Actually tried to add a custom formatting, but didn't add the "" around AM or PM. duh.

But with that said, and with what I think I know now it should be possible to enter just a 3 digit number and have excel take care of the rest.
Not that this doesn't work, but it saves 2 extra key presses per cell.... :P Efficiency!!

I'll keep tinkering along (though suggestions are still welcome)... thanks for your help.

 

[My Aswer Is This]

The main thing is if you use formulas to calculate time.

I would test out my formula before writing a whole lot of code.

With my script you enter 7:25

That's 4 key press's

Your friends way of entering 725 is three key press's

you only save one key press.

 

[MartinS13X]

Try:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Temp As Variant
If Not Application.Intersect(Target, Range("C6:L28")) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Target.HasFormula = True Then Exit Sub
Application.EnableEvents = False
With Target
    Temp = .Value
        If IsNumeric(Temp) = True Then
                If Temp >= 700 Then
                        .Value = TimeSerial(Int(Temp / 100), Temp Mod 100, 0)
                Else
                        .Value = TimeSerial(Int(Temp / 100), Temp Mod 100, 0) + 0.5
                End If
                .NumberFormat = "hh:mm AM/PM"
        Else
          MsgBox "You did not enter a valid time"
End If
End With
Application.EnableEvents = True
End If
End Sub

Thanks for the reply.
Maybe I'm doing something wrong, but unfortunately it doesn't seem to have any effect?

Trying to interpret the code and learn.