How to use either a ":" or no ":" on a range on time input

B

bdouglas1011

New Member
Joined
Jul 28, 2014
Messages
38
I have this code that allows the user to enter the time as 1520 not 15:20.... saves on time.... but if you or someone not used to the sheet uses a ":" it messes up the cell.

Can this be altered to include both versions. Either use : or dont.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim EndTime As Range
Dim SBlank As String
SBlank = """" & """"
Set EndTime = Range("B10:B47")

Application.EnableEvents = True

If Target.Column <> 2 Or Target.Count > 1 Or Target.row < 10 Or Target.row > 47 Then Exit Sub

If Not Application.Intersect(EndTime, Range(Target.Address)) Is Nothing Then
    If Target.Value = "" Then
        Target.Offset(1, -1).Value = ""
        GoTo 99
    End If
    
                If Intersect(Target, Range("B10:B47")) Is Nothing Then Exit Sub
                Dim xHour As String
                Dim xMinute As String
                Dim xWord As String
                Application.EnableEvents = False
                xWord = Format(Target.Value, "0000")
                xHour = Left(xWord, 2)
                xMinute = Right(xWord, 2)
                On Error Resume Next
                Target.Value = TimeValue(xHour & ":" & xMinute)
                On Error Resume Next
                Application.EnableEvents = True
    
    
    
    
    If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then
        Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.row & ")," & SBlank & ",B" & Target.row & ")"
    End If
        
    
    
End If
99:
End Sub
 
Sort by date Sort by votes
If the user uses a colon to enter, Excel will read that as a time, i.e. a number. Most likely it will be <1. So you could test if the cells value was <1. If so, assume time entered (i.e. user used : ) if not use your routine.
 
Upvote 0
Try:
VBA Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B10:B47")) Is Nothing Or (Target < 1 And Target >= 0) Then Exit Sub
    If Target > 2400 Or Target < 0 Or Not IsNumeric(Target) Then
        MsgBox "time input hh:mm or hhmm please!"
        Target.Value = ""
        Exit Sub
    Else
        Target.Value = Target / 2400
    End If
End Sub
 
Upvote 0
bebo021999 said:
Try:
VBA Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B10:B47")) Is Nothing Or (Target < 1 And Target >= 0) Then Exit Sub
    If Target > 2400 Or Target < 0 Or Not IsNumeric(Target) Then
        MsgBox "time input hh:mm or hhmm please!"
        Target.Value = ""
        Exit Sub
    Else
        Target.Value = Target / 2400
    End If
End Sub
Click to expand...
I added your code and thought all was good but then I found an error
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim EndTime As Range
Dim SBlank As String
SBlank = """" & """"
Set EndTime = Range("B10:B47")

Application.EnableEvents = True

   If Target.Column <> 2 Or Target.Count > 1 Or Target.row < 10 Or Target.row > 47 Then Exit Sub

   If Not Application.Intersect(EndTime, Range(Target.Address)) Is Nothing Then
    If Target.Value = "" Then
        Target.Offset(1, -1).Value = ""
        GoTo 99
    End If
    
             '   If Intersect(Target, Range("B10:B47")) Is Nothing Then Exit Sub
             '   Dim xHour As String
             '   Dim xMinute As String
             '   Dim xWord As String
             '   Application.EnableEvents = False
             '   xWord = Format(Target.Value, "0000")
             '   xHour = Left(xWord, 2)
             '   xMinute = Right(xWord, 2)
             '   On Error Resume Next
             '   Target.Value = TimeValue(xHour & ":" & xMinute)
             '   On Error Resume Next
             '   Application.EnableEvents = True
          
          
                
                If Intersect(Target, Range("B10:B47")) Is Nothing Or (Target < 1 And Target >= 0) Then Exit Sub
                If Target > 2400 Or Target < 0 Or Not IsNumeric(Target) Then
                    MsgBox "time input hh:mm or hhmm please!"
                    Target.Value = ""
                    Exit Sub
                Else
                    Target.Value = Target / 2400
                End If
    
    
    
    If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then
        Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.row & ")," & SBlank & ",B" & Target.row & ")"
    End If
        
    
    
' End If
99:
End Sub


When you use "1425" it will carry the time down to the next row in the A Column. but when you use the "1425" it does not carry the time down to the next row in the A column.

Hope you can figure how to accomplish this.
 
Upvote 0
bdouglas1011 said:
I added your code and thought all was good but then I found an error
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim EndTime As Range
Dim SBlank As String
SBlank = """" & """"
Set EndTime = Range("B10:B47")

Application.EnableEvents = True

   If Target.Column <> 2 Or Target.Count > 1 Or Target.row < 10 Or Target.row > 47 Then Exit Sub

   If Not Application.Intersect(EndTime, Range(Target.Address)) Is Nothing Then
    If Target.Value = "" Then
        Target.Offset(1, -1).Value = ""
        GoTo 99
    End If
   
             '   If Intersect(Target, Range("B10:B47")) Is Nothing Then Exit Sub
             '   Dim xHour As String
             '   Dim xMinute As String
             '   Dim xWord As String
             '   Application.EnableEvents = False
             '   xWord = Format(Target.Value, "0000")
             '   xHour = Left(xWord, 2)
             '   xMinute = Right(xWord, 2)
             '   On Error Resume Next
             '   Target.Value = TimeValue(xHour & ":" & xMinute)
             '   On Error Resume Next
             '   Application.EnableEvents = True
         
         
               
                If Intersect(Target, Range("B10:B47")) Is Nothing Or (Target < 1 And Target >= 0) Then Exit Sub
                If Target > 2400 Or Target < 0 Or Not IsNumeric(Target) Then
                    MsgBox "time input hh:mm or hhmm please!"
                    Target.Value = ""
                    Exit Sub
                Else
                    Target.Value = Target / 2400
                End If
   
   
   
    If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then
        Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.row & ")," & SBlank & ",B" & Target.row & ")"
    End If
       
   
   
' End If
99:
End Sub


When you use "1425" it will carry the time down to the next row in the A Column. but when you use the "1425" it does not carry the time down to the next row in the A column.

Hope you can figure how to accomplish this.
Click to expand...
Sorry had to reply I forgot the Colon--

When you use "1425" it will carry the time down to the next row in the A Column. but when you use the "14:25" it does not carry the time down to the next row in the A column.

Hope you can figure how to accomplish this.
 
Upvote 0
Try this
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim flag As Boolean, theEntry As Double
   
    If Not (Application.Intersect(Target, Range("B10:B47")) Is Nothing) Then
        If Target.Cells.Count = 1 Then
            If IsNumeric(Target.Value) Then
                theEntry = CDbl(Target.Value)

                If 0 <= theEntry And theEntry <= 2400 Then
                    Application.EnableEvents = False

                    If theEntry < 1 Then
                        flag = True
                        Target.Value = CDate(theEntry)
                    Else
                        theEntry = Int(theEntry)
                        If theEntry Mod 100 < 60 Then
                            flag = True
                            Target.Value = TimeValue(Format(theEntry, "00:00") & ":00")
                        Else
                            ' Target.NumberFormat = "general"
                        End If
                    End If

                    Application.EnableEvents = True
                End If

            End If
            If Not flag Then MsgBox "enter a time"
        End If
    End If
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

K
  • Solved
VBA multiple target.column
Replies
7
Views
131
Joe4
Joe4
R
  • Question Question
color cell in red, when entering empty time value
Replies
2
Views
199
robertvdb
R
D
  • Question Question
Locking of cells after not working
2
Replies
11
Views
270
Dazzatron
D
E
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
2
Replies
16
Views
391
Alex Blakenburg
A
E
  • Locked
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
Replies
2
Views
183
Fluff
Fluff

Forum statistics

Threads
1,226,771
Messages
6,192,924
Members
453,767
Latest member
922aloose

Share this page

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