Trial period with password

babycody

Well-known Member
Joined
Jul 8, 2003
Messages
1,395
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:

Code:
 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
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Joe Was

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
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

Well-known Member
Joined
Jul 8, 2003
Messages
1,395
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

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
I changed the code I posted above, it works now I checked it out!
 

babycody

Well-known Member
Joined
Jul 8, 2003
Messages
1,395

ADVERTISEMENT

Code:
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.
 

Joe Was

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
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

Well-known Member
Joined
Jul 8, 2003
Messages
1,395
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,658
Messages
5,597,403
Members
414,142
Latest member
Banyangt

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top