Macro: Replace number with time, interpret AM/PM

MartinS13X

New Member
Joined
Apr 4, 2018
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
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).

ABCDEFGHIJKLM
1Monday Monday
Tuesday Tuesday WednesdayWednesdayThursdayThursdayFriday FridayWeek Total
2InOutInOutInOutInOutInOut
371530070030070030070030070023038:15
47:15 AM 3:00 PM7:00 AM3:00 PM7:00 AM3:00 PM7:00 AM3:00 PM7:00 PM2:30 PM38:15
5

<tbody>
</tbody>

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:

Code:
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
 
I think you should tell your friend to enter times like this
9:25

Or

1:45

And this script will work:

Code:
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
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
I forgot about changing range to C6

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

Code:
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
 
Upvote 0
I forgot about changing range to C6

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

Code:
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.
 
Upvote 0
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.
 
Upvote 0
Try:
Code:
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.
 
Upvote 0

Forum statistics

Threads
1,214,611
Messages
6,120,509
Members
448,967
Latest member
screechyboy79

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top