Help with time VBA
 

Hi,

Im trying to use the code down below. It´s from Chip Pearsons site and works
great if I dont change it as I have done.(se target Range) As you can se I
need to select areas in the sheet, otherwise it gives me another problem, as
I have digits that shall not be changed.

What have I done wrong?

Private Sub WorkSheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("F1:I1000"), ("K1:N1000"),
("p1:s1000"), ("u1:x1000"), ("z1:ac1000"), ("ae1:ah1000"), ("ajK1:an1000"))
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 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 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 "Vill du mata in det här värdet?"
Application.EnableEvents = True
End Sub


Thanks in advance!

//Thomas

Help with time VBA
 

Hi
one way (not fully tested though) try:

Private Sub WorkSheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String
Dim comp_rng as range
On Error GoTo EndMacro

'If target.cells.count 1 then exit sub 'you may want to add this
line

Set comp_rng =
Union(Range("F1:I1000"),Range("K1:N1000"),Range("P 1:S1000"),_
Range("U1:X1000"),Range("Z1:AC1000"),Range("AE1:AH 1000"),Range("AJK1:AN
1000"))

If Application.Intersect(Target, comp_rng) Is Nothing Then Exit Sub
'.....



--
Regards
Frank Kabel
Frankfurt, Germany

Jonsson wrote:
Hi,

Im trying to use the code down below. It´s from Chip Pearsons site
and works great if I dont change it as I have done.(se target Range)
As you can se I need to select areas in the sheet, otherwise it gives
me another problem, as I have digits that shall not be changed.

What have I done wrong?

Private Sub WorkSheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("F1:I1000"), ("K1:N1000"),
("p1:s1000"), ("u1:x1000"), ("z1:ac1000"), ("ae1:ah1000"),
("ajK1:an1000")) 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 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 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 "Vill du mata in det här värdet?"
Application.EnableEvents = True
End Sub


Thanks in advance!

//Thomas

Help with time VBA
 

Hi Thomas,

Change this

If Application.Intersect(Target, Range("F1:I1000"), ("K1:N1000"),
("p1:s1000"), ("u1:x1000"), ("z1:ac1000"), ("ae1:ah1000"), ("ajK1:an1000"))
Is Nothing Then

to this

If Application.Intersect(Target, Range("F1:I1000, K1:N1000, P1:S1000, "
& _
"U1:X1000, Z1:AC1000,
AE1:AH1000," & _
"AJ1:AN1000")) Is Nothing Then


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Jonsson" wrote in message
...
Hi,

Im trying to use the code down below. It´s from Chip Pearsons site and
works
great if I dont change it as I have done.(se target Range) As you can se I
need to select areas in the sheet, otherwise it gives me another problem,
as
I have digits that shall not be changed.

What have I done wrong?

Private Sub WorkSheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("F1:I1000"), ("K1:N1000"),
("p1:s1000"), ("u1:x1000"), ("z1:ac1000"), ("ae1:ah1000"),
("ajK1:an1000"))
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 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 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 "Vill du mata in det här värdet?"
Application.EnableEvents = True
End Sub


Thanks in advance!

//Thomas