In order to allow for quick time entry, I have a custom format of
0":"00
so that entering 516 will result in 5:16. This works fine but I'd like to add whether it is in AM or PM.
I've tried adding AM/PM to the end of this custom format
0":00 AM/PM
so ideally, it would display as 5:16 PM if the cell was filled in in the PM. Unfortunately, it only ever shows AM, regardless of what time it was entered.
Does anyone know how I can get this functionality? Maybe a custom format isn't the option I'm looking for?
Say we are entering values in column A. If we enter:
516
in A1 and it is morning when we make the entry, we want Excel to convert the value to:
5:16 AM
If it is afternoon when the entry is made, we want the value to convert to 5:16 PM
Place the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim trail As String, v As String
With Target
If Intersect(Range("A:A"), Target) Is Nothing Then Exit Sub
If .Value = "" Then
Application.EnableEvents = False
.Clear
Application.EnableEvents = True
Exit Sub
End If
trail = Right(CStr(Now()), 2)
v = .Text
mins = Right(v, 2)
hrs = Mid(v, 1, Len(v) - 2)
If trail = "PM" Then hrs = hrs + 12
Application.EnableEvents = False
.Clear
.Value = TimeSerial(hrs, mins, 0)
.NumberFormat = "[$-en-US]h:mm AM/PM;#"
Application.EnableEvents = True
End With
End Sub
This will result in true Excel time values with the correct format.
Related
I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )
I have a created a Userform that auto-populates the Date and Time into a TextBox (TextBox2).
What I want is for the OptionButtons (OptionButton 5 = Start Shift) (OptionButton6 = End Shift) to auto select based on the date and time from TextBox2. I am only focused on the time, the date isn't as important.
I want OptionButton5 to autoselect if the time is equal to or before 10AM.
I want OptionButton6 to autoselect if the time is equal to or after 10:01AM.
I wasn't sure if this was possible. Ive been looking for any code I could find, and haven't had any luck.
Something like the code below will help you achieve what you are wanting, this will enter the date and time into Textbox1 when the Userform is Initialized, then under the Textbox1_Change method, it will check whether it is before or after 10:00 and set the option buttons accordingly:
Private Sub TextBox1_Change()
Dim val As Variant
val = Format(TextBox1.Value, "hh:mm")
If val > "10:00" Then
OptionButton1.Value = True
Else
OptionButton2.Value = True
End If
End Sub
Private Sub UserForm_Initialize()
TextBox1.Value = Format(Now(), "dd/mm/yyyy hh:mm")
End Sub
avid reader, first time poster here. I have a Macro that I obtained from the internet for the most part, then made some adjustments. It's purpose is to color code cells that have passed a certain duration. It was working fine earlier, but now I am getting an error on it for a "Type Mismatch". The line that reads "This is where the error is" is where I am getting the mismatch. I am puzzled because it was working fine earlier. I am not a seasoned programmer by any means, but I just try to troubleshoot things. I have looked all over the net and cant find a specific answer to my question.
In addition, if any of you are willing, I would appreciate your advice on how to make this code run ONLY at startup of the workbook and NOT periodically as it is set up to do so now.This code is not placed in a worksheet, but in a Module.I mention this because I am not sure how much of a practical difference it can make any help is appreciated, thanks!
Public TimeToRun As Date
Sub Auto_Open()
Call ScheduleCompareTime
End Sub
Sub ScheduleCompareTime()
TimeToRun = Now + TimeValue("00:00:10")
Application.OnTime TimeToRun, "CompareTimeStamp"
End Sub
Sub CompareTimeStamp()
Dim rgTimeStamp As Range
Dim rdTimeStamp As Range
Dim i As Long
Dim j As Long
Dim MyNow As Date
Dim TimeStamp As Date, TimeStampp As Date
Set rgTimeStamp = Range("c1:c500")
Set rdTimeStamp = Range("H1:h500")
For i = 1 To rgTimeStamp.Rows.Count
If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell
MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly
TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!!
If TimeStamp < MyNow Then 'if it's old at all
rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red
End If
End If
Next
For j = 1 To rdTimeStamp.Rows.Count
If Not rdTimeStamp.Cells(j, 1) < 1 Then
MyNow = CDate(Now - TimeSerial(0, 0, 0))
TimeStampp = CDate(rdTimeStamp.Cells(j, 1))
If TimeStampp < MyNow Then
rdTimeStamp.Cells(j, 1).Interior.ColorIndex = 3
End If
End If 'closes If Not
Next
Call ScheduleCompareTime 'begins the scheduler again
End Sub
Sub auto_close() 'turn the scheduler off so you can close workbook
Application.OnTime TimeToRun, "CompareTimeStamp", , False
End Sub
You probably have data in one or more cells that Excel cannot convert to a date. You can get around this by adding some simple checking such as this:
'.... beginning of your code
If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell
MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly
If IsDate(rgTimeStamp.Cells(i, 1)) = False Then
MsgBox "Invalid date found in cell " & rgTimeStamp.Cells(i, 1).Address(False, False)
Exit Sub
End If
TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!!
If TimeStamp < MyNow Then 'if it's old at all
rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red
End If
End If
'... rest of your code
If you only want the code to run at startup then change Sub Auto_Open to this:
Sub Auto_Open()
Call CompareTimeStamp
End Sub
Hi I'm wondering what is the quickest (least memory using) way to check a range of data points to see if the points are valid.
Lets say I have a rng = Range("A1:A100"). I want to write something such that
If c in rng = "N/A Requesting Data..." Then
x = false
Else
Application.OnTime Now() + TimeValue("00:00:05"), "refresh" .... etc.
End if
Can i do this without looping?
This checks A1:A100 of the ActiveSheet. If no cells contain "N/A" as part of their text RangeLooksGood is set to True.
Sub TestRangeForValidContent()
Dim RangeLooksGood As Boolean
With ActiveSheet
RangeLooksGood = (Application.WorksheetFunction.CountIf(.Range("A1:A100"), "*N/A*") = 0)
End With
If RangeLooksGood Then
Application.OnTime Now() + TimeValue("00:00:05"), "refresh"
End If
End Sub
I am building a template/form in excel that will be used by different people on different computers to fill in some information and then send it by email to me.
When the template is being filled I need to assign an unique ID number to a field along with other info(kind of like a request ID). I am generating this unique ID by using
CONCATENATE("NER-";DEC2HEX(RANDBETWEEN(0;4294967295);8))
This formula serves me good for the task at hand.
My challenge is to evaluate this formula only one time in the template and then keep it the same when I open the file once it gets to me. Something along the lines of a time stamp. I have already looked into some methods but I cannot seem to get it to work.
I have tried making use of:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A2:A10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
But I do not know how to integrate my concatenate function into the code. I am also not extremely sure if this will keep my unique value untouched when I open the template on my computer.
I would guess that a method that would limit my iterations in the entire sheet would also serve me good.
You could generate and store the ID right when the user first opens the workbook/template, placing this code in the ' ThisWorbook module:
Private Sub Workbook_Open()
'ID already set?
If Sheet1.Range("A2").Value <> "" Then Exit Sub
'Prevent that ID is generated on your machine
If Environ$("Username") = "YOURUSERNAME" Then Exit Sub
'Store ID
Sheet1.Range("A2").Value = _
"NER-" & [DEC2HEX(RANDBETWEEN(0,4294967295),8)]
End Sub