Time formating issue

[rjplante]

I am running the macro listed below that converts time values entered as 705 or 1335 as 7:05 and 13:35. When I enter a value such as 705, I get an error that reads:

Run-time error '1004': Unable to set the NumberFormat property of the Range class


When the VBA debugger window opens, the line below is highlighted with red text.

Why is this formatting issue running into a problem? It has been working fine for months and now this has started popping up? What do I do to fix the issue?

Thanks for all the help,

Robert

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
     
    If Target.Cells.Count > 1 Then Exit Sub
     
     'Define the range where you want the code to work (our example is "C:G").
     'Change within the " marks
    If Intersect(Target, Range("D17:W23")) Is Nothing Then Exit Sub
     
On Error GoTo errHandler:
     
    With Target
        If IsNumeric(.Value) Then
            Application.EnableEvents = False
            Select Case .Value
            Case 0
                .NumberFormat = "[h]:mm"
            Case 1 To 99
                .Value = TimeSerial(0, .Value, 0)
                .NumberFormat = "[h]:mm"
            Case 100 To 2399
                .Value = TimeSerial(Int(.Value / 100), .Value Mod 100, 0)
                .NumberFormat = "[h]:mm"
            Case 10000 To 235959
                .Value = TimeSerial(Int(.Value / 10000), _
                Int((.Value Mod 10000) / 100), .Value Mod 100)
                .NumberFormat = "[h]:mm:ss"
            Case 240000 To 245959
                .Value = TimeSerial(0, Int((.Value Mod 10000) / 100), .Value Mod 100)
                .NumberFormat = "[h]:mm:ss"
            Case Else
            End Select
        End If
    End With
errHandler:
    Application.EnableEvents = True
End Sub

 

[Toonies]

Hi try this

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TimeStrText As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("D17:W23")) 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
            TimeStrTimeStrText = "00:0" & .Value
        Case 2 ' e.g., 12 = 00:12 AM
            TimeStrTimeStrText = "00:" & .Value
        Case 3 ' e.g., 735 = 7:35 AM
            TimeStrTimeStrText = Left(.Value, 1) & ":" & _
            Right(.Value, 2)
        Case 4 ' e.g., 1234 = 12:34
            TimeStrTimeStrText = Left(.Value, 2) & ":" & _
            Right(.Value, 2)
        Case Else
            Err.Raise 0
    End Select
    .Value = TimeValue(TimeStrTimeStrText)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "Are you sure you want to enter this"
Application.EnableEvents = True
End Sub

 

[Dartagnan]

Curious. Your code works fine for me.

What version of Excel are you on?

 

[Toonies]

Hi Excel 2003 found the code but cannot remember where

 

[rjplante]

I am running Excel 2007.

 

[rjplante]

With the code below, the line in red has the error, variable not defined.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TimeStrText As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("D17:W23")) 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
            TimeStrTimeStrText = "00:0" & .Value
        Case 2 ' e.g., 12 = 00:12 AM
            TimeStrTimeStrText = "00:" & .Value
        Case 3 ' e.g., 735 = 7:35 AM
            TimeStrTimeStrText = Left(.Value, 1) & ":" & _
            Right(.Value, 2)
        Case 4 ' e.g., 1234 = 12:34
            TimeStrTimeStrText = Left(.Value, 2) & ":" & _
            Right(.Value, 2)
        Case Else
            Err.Raise 0
    End Select
    .Value = TimeValue(TimeStrTimeStrText)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "Are you sure you want to enter this"
Application.EnableEvents = True
End Sub

 

[Toonies]

Hi I have just tried it in Excel 2010 and works fine

 

[Toonies]

I finally remembered the location that I found the code

http://www.cpearson.com/excel/datetimeentry.htm

 

[rjplante]

Toonies,

Thanks for the link, I am back in business!

Robert