VBA Help - Time

cccontour

New Member
Joined
Oct 15, 2006
Messages
8
I want to use the code below in Cells C15:C21. Also, I want to use a Variation of the code for G15:G21. Can someone PLEASE help me how to do that? Thank you, thank you thank you!!!


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

On Error GoTo EndMacro
If Application.Intersect(Target, range("c15:c21")) Is Nothing Then
Exit Sub
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 1 ' e.g., 1 = 01:00 AM
TimeStr = "0" & .Value & ":0 AM"
Case 2 ' e.g., 12 = 12:00 AM
TimeStr = .Value & ":0 AM"
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34 AM
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 6 ' e.g., 123 pm = 1:23 PM
HourStr = Left(.Value, 1)
MinuteTempStr = Left(.Value, 3)
MinuteStr = Right(MinuteTempStr, 2)
TimeStr = HourStr & ":" & MinuteStr & Right(.Value, 2)
Case 7 ' e.g., 1234 pm = 12:34 PM
HourStr = Left(.Value, 2)
MinuteTempStr = Left(.Value, 4)
MinuteStr = Right(MinuteTempStr, 2)
TimeStr = HourStr & ":" & MinuteStr & 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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Hi,

Welcome to the board.

When you say a variation of the code can you be a bit more specific. Do you just want to perform the same action on G15:G21 at the same time?

Dom
 
Upvote 0
Thanks for such a prompt response. The difference that I want for C15:C21 and G15:G21 is as such

C15:C21
Case 1 ' e.g., 1 = 01:00 AM
TimeStr = "0" & .Value & ":0 AM"
Case 2 ' e.g., 12 = 12:00 AM
TimeStr = .Value & ":0 AM"

G15:G21
Case 1 ' e.g., 1 = 01:00 PM
TimeStr = "0" & .Value & ":0 PM"
Case 2 ' e.g., 12 = 12:00 PM
TimeStr = .Value & ":0 PM"
 
Upvote 0
Hi,

Think this should do what you're after.

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr, HourStr, MinuteTempStr, MinuteStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("c15:c21,g15:g21")) Is Nothing Then
Exit Sub
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 1 ' e.g., 1 = 01:00 AM
    Select Case .Column
    Case 3
    TimeStr = "0" & .Value & ":0 AM"
    Case 7
    TimeStr = "0" & .Value & ":0 PM"
    End Select
Case 2 ' e.g., 12 = 12:00 AM
    Select Case .Column
    Case 3
    TimeStr = .Value & ":0 AM"
    Case 7
    TimeStr = .Value & ":0 PM"
    End Select
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34 AM
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 6 ' e.g., 123 pm = 1:23 PM
HourStr = Left(.Value, 1)
MinuteTempStr = Left(.Value, 3)
MinuteStr = Right(MinuteTempStr, 2)
TimeStr = HourStr & ":" & MinuteStr & Right(.Value, 2)
Case 7 ' e.g., 1234 pm = 12:34 PM
HourStr = Left(.Value, 2)
MinuteTempStr = Left(.Value, 4)
MinuteStr = Right(MinuteTempStr, 2)
TimeStr = HourStr & ":" & MinuteStr & 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

Hope it helps.

Dom
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,943
Members
448,534
Latest member
benefuexx

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