Forum Discussion
JonathanSantos
Jul 16, 2022Copper Contributor
Excel Time Formatting
Hi Everyone, I'm trying to find a way I could type H AM/PM and automatically change to H:MM AM/PM Ex: input 5p output 5:00 PM I can use formulas or code on VBA.
- Jul 17, 2022
Let's say you want to be able to enter a time as 3a or 12p in D2:D100.
Right-click the sheet tab.
Select 'View Code' from the context menu.
Copy the following code into the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim h As Long If Not Intersect(Range("D2:D100"), Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False For Each rng In Intersect(Range("D2:D100"), Target) h = Val(rng.Value) If h >= 1 And h <= 12 Then If h = 12 Then h = 0 If rng.Value Like "*a" Then rng.Value = TimeSerial(h, 0, 0) ElseIf rng.Value Like "*p" Then rng.Value = TimeSerial(h + 12, 0, 0) End If End If Next rng Application.EnableEvents = True Application.ScreenUpdating = True End If End SubSwitch back to Excel and test thoroughly.
JonathanSantos
Jul 17, 2022Copper Contributor
Unfortunately that didn't work, with that formula I still need to type h:mm am/pm I'm trying to have the user only type h am/pm ex: input 2p output 2:00 PM.
With this VBA code anything I type it would make every cell 1:20 PM.
But thank you for trying.
HansVogelaar
Jul 17, 2022MVP
Let's say you want to be able to enter a time as 3a or 12p in D2:D100.
Right-click the sheet tab.
Select 'View Code' from the context menu.
Copy the following code into the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim h As Long
If Not Intersect(Range("D2:D100"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rng In Intersect(Range("D2:D100"), Target)
h = Val(rng.Value)
If h >= 1 And h <= 12 Then
If h = 12 Then h = 0
If rng.Value Like "*a" Then
rng.Value = TimeSerial(h, 0, 0)
ElseIf rng.Value Like "*p" Then
rng.Value = TimeSerial(h + 12, 0, 0)
End If
End If
Next rng
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
Switch back to Excel and test thoroughly.