Here is a revision that allows more entries to be parsed correctly for being
a time value. For example, you can enter 3p, 3:00, and so on as before;
however, you can also enter things like 934, 1723, 1234p, etc.; that is, if
it is missing the colon, the colon will be inserted and then, if the entry
can be made into a date at all, it will be, otherwise an error message will
be issued. Try it out on varying "time" values to see what I mean.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As String
If Target.Count 1 Then Exit Sub
With Target
If Not Intersect(Target, Range("D:G")) Is Nothing Then
On Error GoTo CleanUp
Application.EnableEvents = False
T = .Value
If T Like "*[aApP]" Then
T = Replace(T, "a", " AM", , , vbTextCompare)
T = Replace(T, "p", " PM", , , vbTextCompare)
ElseIf T Like "*[AaPp][mM]" Then
T = Left(T, Len(T) - 2) & " " & Right(T, 2)
End If
If Not IsDate(T) And InStr(T, ":") = 0 And Len(T) 1 Then
T = Left(T, InStr(T & " ", " ") - 3) & ":" & _
Mid(T, InStr(T & " ", " ") - 2)
End If
T = WorksheetFunction.Trim(T)
If IsDate(T) Then
.Value = CDate(T)
Else
MsgBox "That is not a real date!"
End If
End If
End With
CleanUp:
Application.EnableEvents = True
End Sub

--
Rick (MVP - Excel)


"Mike H" wrote in message
...
Bingo!!! we are not worthy:) Nice code.

Mike

"Rick Rothstein" wrote:

Well, it had been tested at one point in my developing the code... and
whenever it was that I had tested it, it did work back then... but
obviously
I changed something since that test and it no longer works. Okay then,
how
about this code instead (it seems to work correctly)?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As String
If Target.Count 1 Then Exit Sub
With Target
If Not Intersect(Target, Range("D:G")) Is Nothing Then
On Error GoTo Whoops
Application.EnableEvents = False
T = Replace(.Value, "a", " AM", , , vbTextCompare)
T = Replace(T, "p", " PM", , , vbTextCompare)
.Value = WorksheetFunction.Trim(T)
End If
End With
Whoops:
Application.EnableEvents = True
End Sub

Note that I also straightened out a problem with when the EnableEvents
statement got executed. Also, I had forgotten to include the On Error
Goto
test (you should also consider incorporating this into your code too).
Thanks for looking at the code I posted and for keeping me honest.

--
Rick (MVP - Excel)


"Mike H" wrote in message
...
10:08p tested?

"Rick Rothstein" wrote:

Whoops! Typo alert. The code should be this...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As String
If Target.Count 1 Then Exit Sub
Application.EnableEvents = False
With Target
If Not Intersect(Target, Range("D:G")) Is Nothing Then
If InStr(.Value, ":") = 0 Then
T = Replace(.Value, " ", "")
.Value = Replace(T, "a", ":00 AM", , , vbTextCompare)
.Value = Replace(T, "p", ":00 PM", , , vbTextCompare)
End If
End If
End With
Application.EnableEvents = True
End Sub

I accidentally replaced "p" with ":00 AM" instead of ":00 PM". I also
took
the opportunity to add an extra measure of protection for the user
entering
too many spaces (not completely sure it is required, but adding the
extra
code insures it doesn't matter). The code should now function
correctly
with
12p or 10:08p.

--
Rick (MVP - Excel)


"Mike H" wrote in message
...
Rick,

It's not my approach :) .Note my comment:-
IMHO I'd enter times correctly but perhaps that's just me!!

I think the multiple types of input the OP propsed dictate the
approach.
Did you test yours for 12p or 10:08p?

Mine fell over for the latter until I ammended this line
minnum = Val(Mid(Target, InStr(1, Target, ":") + 1, Len(Target) -
1))

I go back to my original proposition, enter times correctly.

Mike

"Rick Rothstein" wrote:

Here is code that is different from Mike's approach (it allows you
to
enter
times in the format you asked about or in real Excel times (your
choice)
and
it works in the columns you asked about...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count 1 Then Exit Sub
Application.EnableEvents = False
With Target
If Not Intersect(Target, Range("D:G")) Is Nothing Then
If InStr(.Value, ":") = 0 Then
.Value = Replace(.Value, "a", ":00 AM", , , vbTextCompare)
.Value = Replace(.Value, "p", ":00 AM", , , vbTextCompare)
End If
End If
End With
Application.EnableEvents = True
End Sub

--
Rick (MVP - Excel)


"art" wrote in message
...
Thanks, but I need two more things.

First when I enter 12a it turns to 12:00 PM and 12p turns to
12:00AM.

Also, can I do this vba for columns D thru G?

Please let me know.



"Mike H" wrote:

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 Then 'column A
If Right(Target, 1) = "a" Or Right(Target, 1) = "p" Then
hournum = Val(Left(Target, Len(Target) - 1))
minnum = Val(Mid(Target, 3, Len(Target) - 1))
If Right(Target, 1) = "p" Then hournum = hournum +
12
Target.Value = TimeSerial(hournum, minnum, 0)
Target.NumberFormat = "[$-409]h:mm AM/PM;@"
Else
Target.Value = ""
Target.Select
MsgBox "Enter a or p!"
End If
End If
Application.EnableEvents = True
End Sub

Mike

"art" wrote:

Hello:

I have the vba code below but I need some changes. I want to
make
that
when
I enter in a cell 5a it should automatically format it to 5:00
AM
and
when I
enter 7p it should format it to 7:00 PM and so on. However I
also
need
that
when I enter 5:05a it should format to 5:05 AM. Is there a way
to
do
this?

Please let me know.

The code I have is as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 Then 'column A
If Right(Target, 1) = "a" Or Right(Target, 1) = "p"
Then
hournum = Val(Left(Target, Len(Target) - 1))
If Right(Target, 1) = "p" Then hournum = hournum +
12
Target.Value = TimeSerial(hournum, 0, 0)
Target.NumberFormat = "[$-409]h:mm AM/PM;@"
Else
Target.Value = ""
Target.Select
MsgBox "Enter a or p!"
End If
End If
Application.EnableEvents = True
End Sub