automatically change the data entered into a cell to a specific format

adscorpio

New Member
Joined
Dec 8, 2012
Messages
2
I saw this done once, however the VBA code is locked and I cannot look at it. I have been dying to know how this was done. I am fairly certain it is VBA execute on enter, however I do not know for sure.

Here is what happens:

Enter value 6p, or 0600p or 1800 into cell, press enter, automatically changes to 6:00 PM

It does this for any time type value entered into the cells. If you just type 0730 it would change to 7:30 AM once you press enter or move to the next cell.

This was a scheduling tool that was put together and very VBA/Macro heavy. I am working on a schedule worksheet of my own and it would be nice to be able to utilize this so that the users are not required to use a colon when entering the time. I have tried just cell formatting but no matter what I make the cell format it will not recognize time entry unless it is entered as 6:00 (pm optional).


 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,508
Office Version
2010
Platform
Windows
I saw this done once, however the VBA code is locked and I cannot look at it. I have been dying to know how this was done. I am fairly certain it is VBA execute on enter, however I do not know for sure.

Here is what happens:

Enter value 6p, or 0600p or 1800 into cell, press enter, automatically changes to 6:00 PM

It does this for any time type value entered into the cells. If you just type 0730 it would change to 7:30 AM once you press enter or move to the next cell.

This was a scheduling tool that was put together and very VBA/Macro heavy. I am working on a schedule worksheet of my own and it would be nice to be able to utilize this so that the users are not required to use a colon when entering the time. I have tried just cell formatting but no matter what I make the cell format it will not recognize time entry unless it is entered as 6:00 (pm optional).
This event code is probably close to what you want...
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim T As String
  If Target.Count > 1 Then Exit Sub
  With Target
    If Not Intersect(Target, Range("D:G")) Is Nothing Then
      On Error GoTo CleanUp
      Application.EnableEvents = False
      T = .Value
      If T Like "*[aApP]" Then
        T = Replace(T, "a", " AM", , , vbTextCompare)
        T = Replace(T, "p", " PM", , , vbTextCompare)
      ElseIf T Like "*[AaPp][mM]" Then
        T = Left(T, Len(T) - 2) & " " & Right(T, 2)
      End If
      If Not IsDate(T) And InStr(T, ":") = 0 And Len(T) > 1 Then
        T = Left(T, InStr(T & " ", " ") - 3) & ":" & _
             Mid(T, InStr(T & " ", " ") - 2)
      End If
      T = WorksheetFunction.Trim(T)
      If IsDate(T) Then
        .Value = CDate(T)
      Else
        MsgBox "That is not a real time value!"
      End If
    End If
  End With
CleanUp:
  Application.EnableEvents = True
End Sub
Change the part I highlighted in red to the address for the range of cells you wish this functionality to be applied to.

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears. This will open up the code window for that worksheet. Copy/Paste the event code into that code window. That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the worksheet itself.
 

adscorpio

New Member
Joined
Dec 8, 2012
Messages
2
You. Are. Awesome. :)

Thanks Rick, I should have come to this board sooner. The only piece I don't need was the msg box, but that's a cool trick, and easy enough to remove.
 

GiGi5

New Member
Joined
May 14, 2014
Messages
1
This event code is probably close to what you want...
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim T As String
  If Target.Count > 1 Then Exit Sub
  With Target
    If Not Intersect(Target, Range("D:G")) Is Nothing Then
      On Error GoTo CleanUp
      Application.EnableEvents = False
      T = .Value
      If T Like "*[aApP]" Then
        T = Replace(T, "a", " AM", , , vbTextCompare)
        T = Replace(T, "p", " PM", , , vbTextCompare)
      ElseIf T Like "*[AaPp][mM]" Then
        T = Left(T, Len(T) - 2) & " " & Right(T, 2)
      End If
      If Not IsDate(T) And InStr(T, ":") = 0 And Len(T) > 1 Then
        T = Left(T, InStr(T & " ", " ") - 3) & ":" & _
             Mid(T, InStr(T & " ", " ") - 2)
      End If
      T = WorksheetFunction.Trim(T)
      If IsDate(T) Then
        .Value = CDate(T)
      Else
        MsgBox "That is not a real time value!"
      End If
    End If
  End With
CleanUp:
  Application.EnableEvents = True
End Sub
Change the part I highlighted in red to the address for the range of cells you wish this functionality to be applied to.

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears. This will open up the code window for that worksheet. Copy/Paste the event code into that code window. That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the worksheet itself.
How can I manipulate the code to only show hours and minutes? Say 1800 is 6:00, no seconds, no AM or PM. Thanks!
 

Forum statistics

Threads
1,082,319
Messages
5,364,535
Members
400,804
Latest member
davileal

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top