Password Timeout- VBA Assistance

[davidhall]

I have the following code below. I am trying to input a date on Sheet 2 cell a1 and time on Sheet 2 cell a2 and have that be the expiration point where the password is no longer valid.

I have highlighted some cells that I have messed around with but can't seem to figure it out.



Sub password_timeout()
'set time limit to user password
'administrator password to set user password and reset date
'maintains a list of previous passwords and dates (current password and date is last row in list)
'need sheet named "PasswordSheet" to use this example (no first row headers!)
Dim Entered_User_Password As String
Dim Current_User_Password As String
Dim Current_Password_Date As Date
Dim Administrator_Password As String
Dim Date_Difference As Long
Dim New_User_Password As String
Current_User_Password = ThisWorkbook.Sheets("PasswordSheet").Range("A65536").End(xlUp)
Current_Password_Date = ThisWorkbook.Sheets("PasswordSheet").Range("A65536").End(xlUp).Offset(0, 1)
Administrator_Password = "pswd"
Date_Difference = DateDiff("d", Now, Current_Password_Date)
EnterUserPassword: Entered_User_Password = InputBox("Enter Password", "Password", "enter password")
Select Case Entered_User_Password
Case ""
Select Case MsgBox("Either you clicked cancel, or the input box was left empty. Do you want to continue?", vbYesNo + vbQuestion, "Password")
Case vbYes
GoTo EnterUserPassword
Case vbNo
'Put code here to handle what to do
Exit Sub
End Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Administrator_Password

NewUserPassword: New_User_Password = InputBox("Enter new user password" & Chr(13) & "The current password is '" & Current_User_Password & "'", "Update User Password", Current_User_Password)
Select Case New_User_Password
Case ""
Select Case MsgBox("Either you clicked cancel, or the input box was left empty. Do you want to continue?", vbYesNo + vbQuestion, "Update User Password")
Case vbYes
GoTo NewUserPassword
Case vbNo
Exit Sub
End Select

Case Is <> ""
Select Case MsgBox("Are you sure you want to update the current password and date?", vbYesNo + vbExclamation, "Update User Password")
Case vbYes
ThisWorkbook.Sheets("PasswordSheet").Range("A65536").End(xlUp).Offset(1, 0) = New_User_Password
ThisWorkbook.Sheets("PasswordSheet").Range("A65536").End(xlUp).Offset(0, 1) = Date
MsgBox "New User Password is '" & New_User_Password & "' " & "and date is " & Date, vbInformation, "Update User Password"
Case vbNo
MsgBox "Current User Password and Date was not updated.", vbInformation, "Update User Password"
Exit Sub
End Select
Exit Sub

End Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Current_User_Password
'SET PASSWORD DURATION HERE (-61 is a 60 day password) Positive number would be for date in future
If Date_Difference > -61Then
MsgBox "Password still valid." 'password still valid, put code here to handle what to do
Else
MsgBox "Password has timed-out. See administrator for new password.", vbInformation, "Password" 'your code here
'Put code here to handle what to do if User_Password has timed-out
End If
Exit Sub
Case Is <> Current_User_Password
Select Case MsgBox("Incorrect Password. Do you want to continue?", vbYesNo + vbExclamation, "Password")
Case vbYes
GoTo EnterUserPassword
Case vbNo
'Put code here to handle what to do
Exit Sub
End Select

End Select
End Sub