Hi everyone!
can someone help me correct the code which was given to me by one of our kind moderators...the problem arise when getting the time difference specially when the time strikes at 12 midnnight....Like if the inputed start time date is 09/23/2009 11:45 PM and the end time and date is 09/24/2009 12:15 AM...it outputs and incorrect value...user was event restricted to enter the end time because of this issue...
the code below i have is:
Sub Endb3()
Dim BreakTime As Integer
Dim dTimeS As Date ' start time
Dim dTimeE As Date ' end time
Dim dTimeL As Date ' time left
Dim dTimeR As Date ' time returned
If CurRow < 1 Then
MsgBox "Please enter a valid Employee ID", vbExclamation
Exit Sub
End If
BreakTime = 30 'Break Time in minutes
dTimeS = Cells(CurRow, "L").Value
dTimeE = dTimeS + TimeSerial(0, BreakTime, 0)
With Me
Select Case Time
Case Is < dTimeE
dTimeL = dTimeE - Time
dTimeR = (dTimeE - TimeSerial(0, 5, 0))
If Time < dTimeR Then
'dTimeR = dTimeR - Time
'MsgBox "You must wait at least " & Minute(dTimeR) _
& " minutes and " & Second(dTimeR) _
& " seconds before returning", vbInformation
MsgBox "You are attempting to logout early. Please logout after " & Format(dTimeR, "hh:mm AM/PM"), vbInformation, "Early LogOut NOT PERMITTED"
Cells(CurRow, "M") = ""
TextBox1.Value = vbNullString
TextBox1.SetFocus
lblemployee.Caption = ""
lblshift.Caption = ""
lblcoach.Caption = ""
TextBox2.Text = ""
lblinout.Caption = ""
lblmsgbox.Caption = ""
ListBox1.RowSource = vbNullString
Exit Sub
Else
lblmsgbox.Caption = "You still have " & Minute(dTimeL) _
& " minutes and " & Second(dTimeL) _
& " seconds remaining. "
End If
Case Is > dTimeE
dTimeL = Time - dTimeE
lblmsgbox.Caption = "You are " & Minute(dTimeL) _
& " minutes and " & Second(dTimeL) _
& " second overbreak. "
Cells(CurRow, "M") = Time
End Select
Cells(CurRow, "M") = Time
Application.Wait (Time() + CDate("00:00:01"))
ActiveWorkbook.save
TextBox1.Value = vbNullString
TextBox1.SetFocus
lblemployee.Caption = ""
lblshift.Caption = ""
lblcoach.Caption = ""
TextBox2.Text = ""
lblinout.Caption = ""
lblmsgbox.Caption = ""
ListBox1.RowSource = vbNullString
End With
End Sub
I appreciate your continous help...
Regards,
Stoey
Bookmarks