Trial period with password

[babycody]

I know this has been asked before. I did a search for making a sheet hidden after a date has passed unless a password is entered. I tried a few of these, but I am a novice coder. When I tried these out I never get a prompt to enter password, or a place to enter password. Here is one of the codes I liked:

 Option Explicit

Private Sub Worksheet_Activate()

If Date > #6/7/2004# Then
MsgBox "This worksheet has expired. (Pay up sucka!)"
ActiveSheet.Protect "password"
Sheets(1).Select
Sheets("YourSheetName").Visible = xlVeryHidden
End If

End Sub

It was written by Half Ace. I changed the date and entered my password in where the code has "password". I also entered the sheet name where it has ("YourSheetName") It did hide the sheet, but never prompted me for a password. I left the quotation marks. I assume that was the correct thing to do. Is there something I am missing? Do I have to create a form for the password to be entered into? How would I tie all of this together if I do? On the post this code came from they mentioned Dim "ans", but never came back to an explanation of what this did. Thanks for any help on this.
http://www.mrexcel.com/board2/viewt...storder=asc&highlight=password+expire&start=0

 

[Joe Was]

Try changing your line to:

ActiveSheet.Protect Password:="password"


This is a full application model:
Note: It is illegal to lock-up the data of some one else even if it is contained in your application!
You could lock the application menu or some other parts that do not contain user data or you make provisions for the user getting their data from the locked application.


Private Sub Worksheet_Activate()
Dim Message, Title, Default, myPW, myUnLock

If Date > #6/7/2004# Then
MsgBox "This worksheet has expired. (Pay up sucka!)"
myUnLock = "password"
Sheets("Sheet1").Protect Password:=myUnLock
Sheets("Sheet1").Select
Sheets("Sheet1").Visible = xlVeryHidden
End If


Message = "Enter your password below:" ' Set prompt.
Title = "Unlock Sheet!" ' Set title.
Default = "" ' Set default.
' Display message, title, and default value.
myPW = InputBox(Message, Title, Default)

If myPW = myUnLock Then
Sheets("Sheet1").Unprotect Password:=myPW
Worksheets("Sheet1").Visible = True
Sheets("Sheet1").Select
End If

End Sub

Sub mySheets()
Worksheets("Sheet1").Visible = True
End Sub

 

[babycody]

Thanks Joe. I changed that part of the code, but it still just gave me the popup "This worksheet has expired. (Pay up sucka!)" and then hid the sheet. It never gave me a place to enter the password. Is this just doing the regular password protected sheet where I would have to go into security under options to enter the password? I have been assuming that a basic user of Excel would just enter a password in a popup screen. If the password were incorrect the sheet would be hidden. If I am correct about my bad assumption then is there a way to do the popup with password prompt? I want to make the process user friendly. Some people may not be familiar with Excel menus. I can see me giving every person a walk thru on where to enter the password.

 

[Joe Was]

I changed the code I posted above, it works now I checked it out!

 

[babycody]

Private Sub Worksheet_Activate()
Dim Message, Title, Default, myPW, myUnLock

If Date > #6/7/2004# Then
MsgBox "This worksheet has expired. (Pay up sucka!)"
myUnLock = "gabriel"
Sheets("Sheet1").Protect Password:=myUnLock
Sheets("Sheet1").Select
Sheets("Sheet1").Visible = xlVeryHidden
End If


Message = "Enter your password below:" ' Set prompt.
Title = "Unlock Sheet!" ' Set title.
Default = "" ' Set default.
' Display message, title, and default value.
myPW = InputBox(Message, Title, Default)

If myPW = myUnLock Then
Sheets("Sheet1").Unprotect Password:=myPW
Worksheets("Sheet1").Visible = True
Sheets("Sheet1").Select
End If

End Sub

Sub mySheets()
Worksheets("Sheet1").Visible = True
End Sub

I entered this code into the worksheet. The only part I changed was were it says gabriel. I am asked for my password. I enter gabriel, and press ok. For some reason the popup "This worksheet has expired. (Pay up sucka!)" comes back up and then I am asked to enter my password again. It just loops thru this over and over. However if I do enter the wrong password it does hide the sheet. This is exactly what I want. Just that one problem.

 

[babycody]

Any ideas on how to stop the looping?

 

[Joe Was]

Copy this code to the "ThisWorkbook" module.
Currently I set the password to "pass1word"

The code now checks on open and if you supply the unlock code I.E. "pass1word" it permanently unlocks Sheet1. It does this by tagging cell "IV1" on Sheet1 with the password if the user enters the correct password/unlock code when asked. If the user does not or cancels then Sheet1 is hidden and protected. The other sheets are not affected by the protection and can still be used.

Dim myPW$

Private Sub Workbook_Open()
'ThisWorkbook code!
Dim Message$, Title$, Default$, myUnLock$, myTest$

Worksheets("Sheet1").Visible = True
myTest = Worksheets("Sheet1").Range("IV1").Value
If (myPW = "pass1word" And myTest = myPW) Then End

myUnLock = "pass1word"
Worksheets("Sheet1").Unprotect Password:=myUnLock

If (Date > #6/7/2004# And _
Worksheets("Sheet1").Visible <> xlVeryHidden And _
myUnLock <> myTest) Then
MsgBox "Your test drive has expired!"
Worksheets("Sheet1").Protect Password:=myUnLock
Worksheets("Sheet1").Visible = xlVeryHidden
End If

If (Date > #6/7/2004# And _
Sheets("Sheet1").Visible = xlVeryHidden) Then
Message = "Enter your Un-Lock code below:" ' Set prompt.
Title = "Unlock Sheet!" ' Set title.
Default = "" ' Set default.
myPW = InputBox(Message, Title, Default)
End If

If myPW = myUnLock Then
Worksheets("Sheet1").Unprotect Password:=myUnLock
Worksheets("Sheet1").Visible = True

'Optional permanent UnLock by password:
'comment the line below to lock each time opened after date!
Worksheets("Sheet1").Range("IV1").Value = myPW

Worksheets("Sheet1").Select
End If

End Sub

Sub mySheets()
Worksheets("Sheet1").Visible = True
Sheets("Sheet1").Select
Worksheets("Sheet1").Unprotect Password:="pass1word"
'Worksheets("Sheet1").Protect Password:="pass1word"
End Sub

 

[babycody]

That works beautifully. VBA is strange though. I saved the workbook and reopened it. The first time I did this I received an error. However the next time it ran smooth. To reset this all I have to do is delete contents of cell IV1 right? Thanks for all the help this is the code I couldn't seem to find.