Column headers throws errors

The following code allows me to quickly enter time by converting the four digits to military time within Columns A & B. In testing I can enter any cell in Columns A and B and it works. However if I enter a column Header if causes the code to inaccurately enter values. Should I amend the code to include a row.count to overcome this issue.

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rColumn As Integer
Dim OldInput As String
Dim NewInput As String
Dim rRow As Integer
rColumn = Target.Column
If rColumn < 3 Then
OldInput = Target.Value
If OldInput > 1 Then
NewInput = Left(OldInput, Len(OldInput) - 2) & ":" & Right(OldInput, 2)
Application.EnableEvents = False
Target = NewInput
Application.EnableEvents = True
End If
End If
End Sub

---

Quote:

---

Originally Posted by Aussiebear

The following code allows me to quickly enter time by converting the four digits to military time within Columns A & B. In testing I can enter any cell in Columns A and B and it works. However if I enter a column Header if causes the code to inaccurately enter values....

---

Hi Ted :hi:

I was not sure what you mean by "...enter a column header..." ?

I entered "1500" in Row 1 and it changes to 15:00 as expected. What am I missing?

By the way, I would suggest adding If Target.Count = 1 Then... I only tack that in, as if you were to (for instance) delete all the cells on the sheet (guess who just tried), you get an 'out of memory' error.

Mark

Column header such as Start, Finish etc. I guess anything other than 4 digits

Quote:

---

Originally Posted by GTO

By the way, I would suggest adding If Target.Count = 1 Then...

---

So adding

Code:

---

If Target.Count > 1 then
Exit Sub

---

Should take care of the accidental selection of multiple cells

or should that have been

Code:

---

If target.Cells.Count > 1 Then
Exit sub

---

Mix and Match

Code:

---

If Target.Count > 1 Then Exit Sub
IF Not Target IsNumeric Then Exit Sub
IF Len(Trim(Target)) <> 4 Then Exit Sub
'That one is tricky if you use 900 for 0900
If (Target > 2400) Or (Target < 1) Then Exit Sub

---

And how do you deal with 12:59 AM ((Target = 59)

Why not just enter the time as mil-time? IE; 13:30 or 0:59, Both of which Excel recognizes as Mil-time and stores the value as Windows Serial time values?

Just being lazy rather than enter the colon between the digits

12:59 is simply 1259 <Enter>

Hi my friend,

Here is what I came up with:

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
 
  If Target.Count = 1 And Target.Column < 3 Then
    With Target
      If .Value Like "#" Or .Value Like "##" Or .Value Like "####" Then
        If .Value < 2400 Then
          Application.EnableEvents = False
          .Value = TimeSerial(Int(.Value / 100), (.Value Mod 100), 0)
          Application.EnableEvents = True
          Target.NumberFormat = "hh:mm"
        End If
      End If
    End With
  End If
 
End Sub

---

You might want to take a gander at one of our KB entries here

Hope that helps?

Mark

or

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False

    If Target.Count = 1 * Target.Column < 3 * IsDate(Format(Target, ",00:00")) Then Target = Format(Target.Value, "00:00")

    Application.EnableEvents = True
End Sub

---

My 2 cents

If you want to handle multiple cells being pasted in

If you want to restrict to a certain column or columns, just add the ... And rCell.Column = 3 ... inside the For

Did you want to leave these as numbers so that you could use them in formulas? This just displays them as hh:mm

Code:

---


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s As String
    Dim rCell As Range
    Application.EnableEvents = False
    For Each rCell In Target.Cells
'        If rCell.Row > 1 And rCell.Column = 3 Then
        If rCell.Row > 1 Then
            If IsNumeric(rCell.Value) Then
                If rCell.Value = 0 Then
                    rCell.ClearContents
                Else
                    s = Format(rCell.Value, "0000")
                    If Len(s) = 4 Then
                        rCell.Value = "'" & Format(Left(s, 2), "00") & ":" & Format(Right(s, 2), "00")
                    End If
                End If
               
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub

---

Paul

I have to amend my previous suggestion:

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False

  If (Target.Count = 1) * (Target.Column < 3) * IsDate(Format(Target, "00:00")) Then Target = Format(Target.Value, "00:00")

  Application.EnableEvents = True
End Sub

---