I want to calculate hours worked when the finish time falls in a different date.
Option Explicit
Private Sub calcHours()
Dim start, finish As Date
start = DateValue("2021/03/28") & " " & TimeValue("18:30:00")
finish = DateValue("2021/03/29") & " " & TimeValue("02:30:00")
Debug.Print hoursWorked(start, finish)
End Sub
Private Function hoursWorked(ByVal start As Date, ByVal finish As Date) As Date
Dim startDateAndTime, finishDateAndTime As Date
startDateAndTime = start
finishDateAndTime = finish
'this will obviously not work.
hoursWorked = finishDateAndTime - startDateAndTime
End Function
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 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)
I am trying to implement millisecond timestamping in Access 2010/13 using this method;
MS Access Can Handle Millisecond Time Values--Really - See more at: http://www.devx.com/dbzone/Article/39046#sthash.xEIruMyE.dpuf
The function Msec(2) is supposed to return the system time in milliseconds but it seems to be about 10 hours out.
Public Function Msec( _
Optional ByVal intTimePart As Integer) _
As Date
' This is the core function.
' It generates the current time with millisecond resolution.
'
' Returns current (local) date/time including millisecond.
' Parameter intTimePart determines level of returned value:
' 0: Millisecond value only.
' 1: Time value only including milliseconds.
' 2: Full Date/time value including milliseconds.
' None or any other value: Millisecond value only.
Const cintMsecOnly As Integer = 0
Const cintMsecTime As Integer = 1
Const cintMsecDate As Integer = 2
Static typTime As SYSTEMTIME
Static lngMsecInit As Long
Dim datMsec As Date
Dim datDate As Date
Dim intMilliseconds As Integer
Dim lngTimeZoneBias As Long
Dim lngMsec As Long
Dim lngMsecCurrent As Long
Dim lngMsecOffset As Long
' Set resolution of timer to 1 ms.
timeBeginPeriod 1
lngMsecCurrent = timeGetTime()
If lngMsecInit = 0 Or lngMsecCurrent < lngMsecInit Then
' Initialize.
' Get bias for local time zone respecting
' current setting for daylight savings.
lngTimeZoneBias = GetLocalTimeZoneBias(False)
' Get current UTC system time.
Call GetSystemTime(typTime)
intMilliseconds = typTime.wMilliseconds
' Repeat until GetSystemTime retrieves next count of milliseconds.
' Then retrieve and store count of milliseconds from launch.
Do
Call GetSystemTime(typTime)
Loop Until typTime.wMilliseconds <> intMilliseconds
lngMsecInit = timeGetTime()
' Adjust UTC to local system time by correcting for time zone bias.
typTime.wMinute = typTime.wMinute - lngTimeZoneBias
' Note: typTime may now contain an invalid (zero or negative) minute count.
' However, the minute count is acceptable by TimeSerial().
Else
' Retrieve offset from initial time to current time.
lngMsecOffset = lngMsecCurrent - lngMsecInit
End If
With typTime
' Now, current system time is initial system time corrected for
' time zone bias.
lngMsec = (.wMilliseconds + lngMsecOffset)
Select Case intTimePart
Case cintMsecTime, cintMsecDate
' Calculate the time to add as a date/time value with millisecond resolution.
datMsec = lngMsec / 1000 / clngSecondsPerDay
' Add to this the current system time.
datDate = datMsec + TimeSerial(.wHour, .wMinute, .wSecond)
If intTimePart = cintMsecDate Then
' Add to this the current system date.
datDate = datDate + DateSerial(.wYear, .wMonth, .wDay)
End If
Case Else
' Calculate millisecond part as a date/time value with millisecond resolution.
datMsec = (lngMsec Mod 1000) / 1000 / clngSecondsPerDay
' Return millisecond part only.
datDate = datMsec
End Select
End With
Msec = datDate
End Function
As Jack hardcastle says; Probably Timezone related.
It never runs this code;
If lngMsecInit = 0 Or lngMsecCurrent < lngMsecInit Then
' Initialize.
' Get bias for local time zone respecting
' current setting for daylight savings.
lngTimeZoneBias = GetLocalTimeZoneBias(False)
' Get current UTC system time.
Call GetSystemTime(typTime)
intMilliseconds = typTime.wMilliseconds
' Repeat until GetSystemTime retrieves next count of milliseconds.
' Then retrieve and store count of milliseconds from launch.
Do
Call GetSystemTime(typTime)
Loop Until typTime.wMilliseconds <> intMilliseconds
lngMsecInit = timeGetTime()
' Adjust UTC to local system time by correcting for time zone bias.
typTime.wMinute = typTime.wMinute - lngTimeZoneBias
' Note: typTime may now contain an invalid (zero or negative) minute count.
' However, the minute count is acceptable by TimeSerial().
But goes to;
Else
' Retrieve offset from initial time to current time.
lngMsecOffset = lngMsecCurrent - lngMsecInit
End If
Answer! From #pathDongle
Time is stored as Millisecond UTC;
!DateTimeMS = GetTimeUTC()
And restored by;
Public Function UTCtoTimeLocal(dSysUTC As Date) As Date
'Dim sysTime As SYSTEMTIME
Dim DST As Long
Dim tzi As TIME_ZONE_INFORMATION
DST = GetTimeZoneInformation(tzi)
UTCtoTimeLocal = dSysUTC - TimeSerial(0, tzi.Bias, 0) + IIf(DST = 2, TimeSerial(1, 0, 0), 0)
End Function
Query;
SELECT tblzzAuditTrail.DateTimeMS, FormatDate(UTCtoTimeLocal([DateTimeMS])) AS DateTimeLocal
Which can be filtered on as a String.
Private Sub BuildFilter()
Dim strFilter As String
Dim ctl As Control
strFilter = ""
'add selected values to string
For Each ctl In Me.FormHeader.Controls
With ctl
If .ControlType = acTextBox Or .ControlType = acComboBox Then
If Nz(.Value) <> "" Then
If InStr(.Name, "Date") <> 0 Then
If Nz(StartDate) <> "" And Nz(EndDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
strFilter = strFilter & "[DateTimeLocal] BETWEEN '" & FormatDate(Me.StartDate.Value) & "' AND '" & FormatDate(Me.EndDate.Value) & "' AND "
ElseIf Nz(StartDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
strFilter = strFilter & "[DateTimeLocal] > '" & FormatDate(Me.StartDate.Value) & "' AND "
ElseIf Nz(EndDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
strFilter = strFilter & "[DateTimeLocal] <= '" & FormatDate(Me.EndDate.Value) & "' AND "
End If
ElseIf InStr(.Name, "ID") <> 0 Then
strFilter = strFilter & "[" & .Name & "] = " & .Value & " AND "
Else
strFilter = strFilter & "[" & .Name & "] = '" & .Value & "' AND "
End If
End If
End If
End With
Next ctl
'trim trailing And
strFilter = TrimR(strFilter, 5)
Debug.Print strFilter
With Me.subfrmzzAuditTrailDisplay
.Form.Filter = strFilter
.Form.FilterOn = True
End With
End Sub
Resulting Filter String;
[UserID] = 2 AND [DateTimeLocal] BETWEEN '06/01/2015 00:00:00.000' AND '07/01/2015 00:00:00.000'
As per my other question;
Millisecond time: Filter form by date
Most of those functions can be simplified down to the following:
Function GetTimeLocal will return the users local system datetime with daylight saving adjustment
Function GetTimeUTC will return UTC time
Function FormatDate will format a Date as a string with the correct millisecond component.
Usually it's better to store all times as UTC and convert if needed.
Option Explicit
#If Win64 Then
Public Declare PtrSafe Sub GetSystemTime Lib "kernel32" (ByRef lpSystemTime As SYSTEMTIME)
Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
#Else
Public Declare Sub GetSystemTime Lib "kernel32" (ByRef lpSystemTime As SYSTEMTIME)
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
#End If
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Sub test()
Dim dtLcl As Date
Dim dtUTC As Date
dtLcl = GetTimeLocal 'Gets local time including adjustement for daylight saving time
dtUTC = GetTimeUTC 'Gets UTC time
Debug.Print FormatDate(dtLcl)
Debug.Print FormatDate(dtUTC)
End Sub
Function FormatDate(ByVal dt As Date) As String
Dim sysTime As SYSTEMTIME
Dim sec As Double
Dim x As Double
With sysTime
.wYear = Year(dt)
.wMonth = Month(dt)
.wDay = Day(dt)
.wHour = Hour(dt)
.wMinute = Minute(dt)
'Second() function rounds to nearest second so calc floor second
'Eg 12:15:09.678 will give second component as 10 instead of 09
x = (dt - Int(dt)) * 86400#
sec = x - Fix(x / 60#) * 60#
.wSecond = Int(sec)
.wMilliseconds = Int(Round(sec - .wSecond, 3) * 1000)
FormatDate = Format(dt, "dd/mm/yyyy hh:mm:ss.") & Format(sysTime.wMilliseconds, "000")
End With
End Function
Public Function GetTimeLocal() As Date
Dim dSysUTC As Date, sysTime As SYSTEMTIME
Dim DST As Long, IsDST As Boolean
Dim tzi As TIME_ZONE_INFORMATION
Dim ms As Double
GetSystemTime sysTime
With sysTime
'Debug.Print "ms=" & .wMilliseconds
ms = CDbl(.wMilliseconds) / (86400# * 1000#)
dSysUTC = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond) + ms
End With
DST = GetTimeZoneInformation(tzi)
GetTimeLocal = dSysUTC - TimeSerial(0, tzi.Bias, 0) + IIf(DST = 2, TimeSerial(1, 0, 0), 0)
End Function
Public Function GetTimeUTC() As Date
Dim dSysUTC As Date
Dim sysTime As SYSTEMTIME
Dim ms As Double
GetSystemTime sysTime
With sysTime
'Debug.Print "ms=" & .wMilliseconds
ms = CDbl(.wMilliseconds) / (86400# * 1000#)
GetTimeUTC = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond) + ms
End With
End Function
I have this code:
Private Sub CalculateBUT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CalculateBUT.Click
If SelectTheDateComboBox.Text = "Calculate the difference between two dates" Then
FromYearTextBox.Text = FromDateTimePicker.Value.Year
FromMonthTextBox.Text = FromDateTimePicker.Value.Month
FromDayTextBox.Text = FromDateTimePicker.Value.Day
ToYearTextBox.Text = ToDateTimePicker.Value.Year
ToMonthTextBox.Text = ToDateTimePicker.Value.Month
ToDayTextBox.Text = ToDateTimePicker.Value.Day
Dim DaysMyString, MonthsMyString, YearsMyString As String
Dim DaysDifferance, MonthsDifferance, YearsDifferance As Long
DaysMyString = FromDateTimePicker.Value.Day
MonthsMyString = FromDateTimePicker.Value.Month
YearsMyString = FromDateTimePicker.Value.Year
DaysDifferance = DateDiff(DateInterval.Day, ToDateTimePicker.Value.Day, CDate(DaysMyString))
MonthsDifferance = DateDiff(DateInterval.Month, ToDateTimePicker.Value.Month, CDate(MonthsMyString))
YearsDifferance = DateDiff(DateInterval.Year, ToDateTimePicker.Value.Year, CDate(YearsMyString))
DifferenceTextBox2.Text = DaysDifferance & "Days, " & MonthsDifferance & "Months, " & YearsDifferance & "Years"
End Sub
and my problem in the picture below :
so, i need some help please.
You want DateDiff to give you the number of days between two dates and you want DaysDifference to hold the result, and that's fine:
DaysDifferance = DateDiff(DateInterval.Day, x, y)
But for this to work x and y need to be dates.
When you take ToDateTimePicker.Value (which is a date) and add .Day on the end it's no longer date.
So you want:
DaysDifferance = DateDiff(DateInterval.Day, ToDateTimePicker.Value, CDate(DaysMyString))