I have a userform in Microsoft Excel that I want to use as a stopwatch. However the format of "hh:mm" does not allow it to go above 23:59 as it goes back to 00:00
Private Sub SpinButton2_SpinUp()
If InsertEvent.TextBox1 = vbNullString Then
InsertEvent.TextBox1 = "00:00"
Else
InsertEvent.TextBox1.Value = Format(DateAdd("n", 1, InsertEvent.TextBox1.Value), "hh:mm")
'InsertEvent.TextBox1.Value = TimeValue("mm:ss")
'InsertEvent.TextBox1.Value = Format(InsertEvent.TextBox1.Value, "hh:mm")
End If
End Sub
Is there anyway to format this so that it can work as a clock of total minutes? Ideally I need it to go to about 125 minutes or so (125:00) but it doesn't matter if it is unlimited.
You can't use the built in Date/Time functions for this as you want a representation that is not a Date/Time.
Assuming you want to read the spinner value into the textbox:
Private Sub SpinButton2_SpinUp()
Dim minutes As Integer: minutes = Val(InsertEvent.SpinButton2.Value)
Dim hh As Integer: hh = minutes \ 60
Dim mm As Integer: mm = minutes - (hh * 60)
InsertEvent.TextBox1.Text = Format$(hh, "00") & ":" & Format$(mm, "00")
End Sub
To use a manually entered value from the textbox as the starting up/down point you need to re-parse "hh:mm" back to minutes, for example in the textbox Exit event:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If (IsNumeric(TextBox1.Text)) Then
'// entering a number only assumes its minutes
SpinButton2.Value = TextBox1.Text
Exit Sub
End If
Dim hhmm() As String: hhmm = Split(TextBox1.Text, ":")
If (UBound(hhmm) = 1) Then
If (IsNumeric(hhmm(0)) And IsNumeric(hhmm(1))) Then
SpinButton2.Value = (hhmm(0) * 60) + hhmm(1)
Exit Sub
End If
End If
SpinButton2.Value = 0
End Sub
(Should add error checking for overflow/exceeding the spinners .Max property)
Related
I am creating Access db which needs auto close the db using timer count down. for example, if I give 5 min then it should start count down displaying this time format 00:04:59
I have found several pieces of tips checking the web, but did not manage to fit the pieces to one working piece.
Below is working perfect. but in output i can see only min and sec 0:00. How to add code for hours as well (format 00:00:00)? I tried to add hours but it is not working
Public Loops As Integer
Private Sub Form_Load()
Me.TimerInterval = 1000
Form_Timer
End Sub
Private Sub Form_Timer()
Static StartTime As Date
Dim SecondsToCount As Integer
SecondsToCount = 15 'Set this variable to the total number of seconds to
count down
If Loops = 0 Then StartTime = Time
Min = (SecondsToCount - DateDiff("s", StartTime, Time)) \ 60
Sec = (SecondsToCount - DateDiff("s", StartTime, Time)) Mod 60
Me.TimeLeft.Caption = "Form will close in " & Min & ":" & Format(Sec,"00")
Loops = Loops + 1
If Me.TimeLeft.Caption = "Form will close in 0:00" Then
DoCmd.Close acForm, Me.Name
End If
End Sub
Use a textbox for display, Timer to get a better resolution, and a TimerInterval of 100 for a closer match.
Complete code-behind module of the form:
Option Compare Database
Option Explicit
Private WatchTime As Date
Private Sub Form_Load()
' Specify count down time.
Const CountDownSeconds As Long = 15
WatchTime = DateAdd("s", CountDownSeconds, Now)
Me!txtCount.Value = WatchTime
Me.TimerInterval = 100
End Sub
Private Sub Form_Timer()
Const SecondsPerDay As Long = 86400
Dim TimeLeft As Date
TimeLeft = CDate(WatchTime - Date - Timer / SecondsPerDay)
Me!txtCount.Value = TimeLeft
If TimeLeft <= 0 Then
Me.TimerInterval = 0
MsgBox "Time ran out!", vbExclamation, "Exit"
DoCmd.Close acForm, Me.Name
End If
End Sub
I am very new to VBA, so please bear with me. I have a userform that is going to eventually create a 2 or 6 week schedule look ahead. The userform has a textbox which automatically populates the Monday of the current week as the lookahead start date. If the user inputs a date, it will use that date as the lookahead start date instead.
The part I can't seem to figure out, is the formula so that when the user inputs a date, it calculates the Monday of that week.
The code:
Private Sub UserForm_Initialize()
'Inserts date of Monday this week into "Start Date" field in UserForm
LookAheadDate1.Value = Date - Weekday(Date) + 2
End Sub
Private Sub Generate_Click()
Dim StartDate As Date
Dim EndDate As Date
Dim ws As Worksheet
Dim addme As Long
Set ws = Worksheets("Projects")
addme = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' Clears Look Ahead sheet - Row 5 and below
With Sheets("Look Ahead")
.Rows(5 & ":" & .Rows.Count).Delete
End With
'Force user to select either option button
If ((Me.OptionButton1.Value = 0) * (Me.OptionButton2.Value = 0)) Then
MsgBox "Please select 2 or 6 Week Look Ahead"
End If
'Force user to select either option button
If ((Me.OptionButton1.Value)) Then
ThisWorkbook.Worksheets("Look Ahead").Range("E6").Value = "2 Week Look Ahead"
End If
If ((Me.OptionButton2.Value)) Then
ThisWorkbook.Worksheets("Look Ahead").Range("E6").Value = "6 Week Look Ahead"
End If
' Set StartDate Variable - If Start Date field value is blank, use this weeks start date, otherwise use start date field value
If IsNull(Me.LookAheadDate1.Value) Or Me.LookAheadDate1.Value = "" Then
StartDate = Date
Else
StartDate = LookAheadDate1.Value
End If
' Option buttons / Code to create end date for 2 or 6 week look ahead
Dim res As Date
If OptionButton1.Value Then
EndDate = StartDate - Weekday(Date) + 16
ElseIf OptionButton2.Value Then
EndDate = StartDate - Weekday(Date) + 44
End If
'Write Look Ahead date range in cell "E7"
ThisWorkbook.Worksheets("Look Ahead").Range("E7").Value = StartDate - Weekday(Date) + 2 & " to " & EndDate
'Clear all fields in UserForm
Dim oneControl As Object
For Each oneControl In ProjectData.Controls
Select Case TypeName(oneControl)
Case "TextBox"
oneControl.Text = vbNullString
Case "CheckBox"
oneControl.Value = False
End Select
Next oneControl
'Close UserForm.
Unload Me
End Sub
Private Sub ToggleButton1_Click()
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub LookAheadDate1_Change()
End Sub
Private Sub Cancel_Click()
'Close UserForm if "Cancel" Button is pressed
Unload Me
End Sub
'Checks for entry of valid date
Private Sub LookAheadDate1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If LookAheadDate1 = vbNullString Then Exit Sub
If IsDate(LookAheadDate1) Then
LookAheadDate1 = Format(LookAheadDate1, "Short Date")
Else
MsgBox "Please Enter Valid Date"
Cancel = True
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'If the user clicks the "X" to close the UserForm, then cancel
If CloseMode = 0 Then Cancel_Click
End Sub
If I understand your question about the date correctly, you want to edit this block of your code:
If IsNull(Me.LookAheadDate1.Value) Or Me.LookAheadDate1.Value = "" Then
StartDate = Date ' <--- this is where you want Monday, right?
Else
StartDate = LookAheadDate1.Value
End If
If so, replace the marked line with
StartDate = Date - Application.WorksheetFunction.Weekday(Date,3)
to get the date of Monday of this week as the StartDate.
Date returns the current date (similar to Now, but without the time part)
The use of Weekday (=WEEKDAY()) to get Monday is from this answer by Paul
Edit
In the Else branch:
Dim enteredDate as Date
enteredDate = CDate(LookAheadDate1.Value)
StartDate = enteredDate - Application.WorksheetFunction.Weekday(enteredDate,3)
CDate converts from text to date according to the current locale. You may need to parse the date text manually if you need a more sophisticated conversion.
I believe LookAheadDate1 is a text box because I see you are giving it a value using Format(..., "Short Date"). If it is a date/time picker, you may not need the CDate call.
I got it working. I added a calendar date picker to input the date into the textbox. Thanks for the help!
I have a timer set as a VB object in a spread sheet. It currently displays as
hh:mm:ss.00. I need it to display as seconds only (no miliseconds or minutes, IE 1:30 should show as 90).
Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Private Sub CommandButton1_Click()
StopTimer = False
Etime0 = Timer() - LastEtime
Do Until StopTimer
Etime = Int((Timer() - Etime0) * 100) / 100
If Etime > LastEtime Then
LastEtime = Etime
Label1.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Sub
Private Sub CommandButton2_Click()
StopTimer = True
Beep
With New MSForms.DataObject
.SetText Label1.Caption
.PutInClipboard
End With
End Sub
Private Sub CommandButton3_Click()
StopTimer = True
Etime = 0
Etime0 = 0
LastEtime = 0
Label1.Caption = "00"
End Sub
I'm sure I'm simply overlooking something obvious but I'm not overly familiar with timers and formatting.
Please refer this link:
Convert HH:MM:SS string to seconds only in javascript
And try this:
var hms = '02:04:33'; // your input string
var a = hms.split(':'); // split it at the colons
// minutes are worth 60 seconds. Hours are worth 60 minutes.
var seconds = (+a[0]) * 60 * 60 + (+a[1]) * 60 + (+a[2]);
console.log(seconds);
This is probably the easiest and the most comprehensive way, as a minute has 60 seconds and one hour has 3600 seconds.
Thus 1 minute and 30 seconds would be 0*3600 + 1*60 + 30:
Public Sub TestMe()
Dim myTime As Date
myTime = TimeSerial(0, 1, 30)
Debug.Print Hour(myTime) * 3600 + Minute(myTime) * 60 + Second(myTime)
End Sub
It takes 1:30 and it returns 90. You may consider writing a separate function like this one as well:
Public Function TimeToSeconds(Optional hours As Long = 0, _
Optional minutes As Long = 0, _
Optional seconds As Long = 0) As Long
TimeToSeconds = hours * 3600 + minutes * 60 + seconds
End Function
What I want to do is to convert time inputs in a cell to a specific format. Example:
"9" or "9 am" = 9:00:00 AM, which is the same as TIME(9, 0, 0)
"9 30" = 9:30:00 AM = TIME(9, 30, 0)
"4 30 pm" = 4:30:00 PM = TIME(16, 30, 0)
How can I achieve this in VBA?
Just a side note, this is actually my first time trying VBA.
Thanks.
I can support some learning:
Function timm(str As String) As Double
Dim spltstr() As String
Dim hr As Integer
Dim min As Integer
Dim sec As Integer
hr = 0
min = 0
sec = 0
str = Replace(str, """", "")
spltstr = Split(str)
hr = spltstr(0)
If UCase(spltstr(UBound(spltstr))) = "PM" Then hr = hr + 12
If 1 <= UBound(spltstr) Then
If IsNumeric(spltstr(1)) Then min = spltstr(1)
End If
timm = TimeSerial(hr, min, sec)
End Function
Place this in a module attached to the workbook. It can then be called as a function directly on the worksheet or from another sub.
It will change the text to a number so you will still need to apply a custom number format to the cell if using this as a UDF.
As per you comments to do it in place then you would use a Worksheet_Change event.
First use a custom format on the whole column that you desire like hh:mm:ss AM/PM. The put this in the worksheet code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo getout
Application.EnableEvents = False
If Not Intersect(Range("A:A"), Target) Is Nothing Then
If Not IsDate(Target.Value) Then
Target = timm(Target.Value)
End If
End If
Application.EnableEvents = True
Exit Sub
getout:
Application.EnableEvents = True
End Sub
It calls the prior code and returns the number. So as you leave edit mode it changes it to a time.
It looks like you want to use Split and TimeSerial. Here's an example to get you started.
Public Function ConvertToTime(ByVal Input_ As String) As Date
Dim vaSplit As Variant
Dim lHour As Long, lMinute As Long
'split the string into an array using space as a delimiter
vaSplit = Split(Input_, Space(1))
'The first element is the hour
lHour = vaSplit(0)
'If there's more than one element, the second element is the minute
If UBound(vaSplit) > 0 Then lMinute = vaSplit(1)
'if the last element is "pm", then add 12 to the hour
If vaSplit(UBound(vaSplit)) = "pm" Then lHour = lHour + 12
ConvertToTime = TimeSerial(lHour, lMinute, 0)
End Function
Problem:
I have searched extensively for this and cannot seem to get it to work. I have a timer running when the "StartBtn" is pressed:
Dim StopTimer As Boolean
Dim SchdTime As Date
Dim Etime As Date
Dim currentcost As Integer
Const OneSec As Date = 1 / 86400#
Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
[TextBox21].Value = "00:00:00"
End Sub
Private Sub StartBtn_Click()
StopTimer = False
SchdTime = Now()
[TextBox21].Value = Format(Etime, "hh:mm:ss")
Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub
Private Sub StopBtn_Click()
StopTimer = True
Beep
End Sub
Sub NextTick()
If StopTimer Then
'Don't reschedule update
Else
[TextBox21].Value = Format(Etime, "hh:mm:ss")
SchdTime = SchdTime + OneSec
Application.OnTime SchdTime, "Sheet1.NextTick"
Etime = Etime + OneSec
End If
End Sub
Then in another cell (say, C16) I have a manually entered value which is the hourly cost rate. I have a third cell that is calculating total cost by C16*current timer value.
What I want to do is record every 5 seconds after the "StartBtn" is clicked the current time and current calculated cost in another sheet. This is what I have started:
Sub increment()
Dim x As String
Dim n As Integer
Dim Recordnext As Date
n = 0
Record = [TextBox21].Value
Recordnext = [TextBox21].Value + OneSec
Range("B13").Value = Recordnext
Do Until IsEmpty(B4)
If [TextBox21].Value = Recordnext Then ActiveCell.Copy
Application.Goto(ActiveWorkbook.Sheets("Sheet2").Range("A1").Offset(1, 0))
ActiveSheet.Paste
Application.CutCopyMode = False
n = n + 1
Recordnext = [TextBox21].Value + 5 * (OneSec)
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
But it doesnt work. Any help would be appreciated.
I have tried to simplify your timer method down to what is actually needed.
Sheet1 code sheet
Option Explicit
Private Sub ResetBtn_Click()
bRun_Timer = False
'use the following if you want to remove the last time cycle
TextBox21.Value = Format(0, "hh:mm:ss")
End Sub
Private Sub StartBtn_Click()
bRun_Timer = True
dTime_Start = Now
TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
Range("D16").ClearContents
Call next_Increment
End Sub
Module1 code sheet
Option Explicit
Public bRun_Timer As Boolean
Public Const iSecs As Integer = 3 'three seconds
Public dTime_Start As Date
Sub next_Increment()
With Worksheets("Sheet1")
.TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
.Range("D16") = Sheet1.Range("C16") / 3600 * _
Second(TimeValue(Sheet1.TextBox21.Value)) '# of secs × rate/sec
Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _
Array(.TextBox21.Value, .Range("D16").Value)
End With
If bRun_Timer Then _
Application.OnTime Now + TimeSerial(0, 0, iSecs), "next_Increment"
End Sub
Note that the operation of transferring the data to Sheet2 is a direct value transfer¹ with no .GoTo, ActiveCell or Select.
It was not entirely clear to me what you were trying to do with the value transfer. I have stacked them one after another on Sheet1.
You would benefit by adding Option Explicit² to the top of all your code sheets. This requires variable declaration and if you misplace a public variable, you will quickly know.
¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
² Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet. This will avoid silly coding mistakes like misspellings as well as influencing you to use the correct variable type in the variable declaration. Variables created on-the-fly without declaration are all of the variant/object type. Using Option Explicit is widely considered 'best practice'.