Password protection :: MrExcel Message Board


 FAQFAQ
   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   FavoritesFavorites   StatisticsStatistics 
 RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 
Online StoreOnline Store

MrExcel Message Board Forum Index -> Excel Questions

Password protection
Post new topic   Reply to topic
Last Thread | Next Thread  >   Printable version
  Author    Thread

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Password protection

icon_banghead.gif I am trying to create a vba that will enable me to have one user enter a password and work in a particular cell and have a second user enter a password to edit a second cell. Any ideas. icon_help.gif [/code]

Post Mon Jul 21, 2003 7:04 pm 
 View user's profile Send private message Send e-mail

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

icon_help.gif
I will expand on my question. I would like for the sheet to be protected until a password is entered by a particular person to edit a cell and then reprotect the cell once they get out of the worksheet. I would need this for two different persons with different passwords.

Thank you
icon_help.gif icon_banghead.gif icon_help.gif

Post Tue Jul 22, 2003 12:41 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Right-Click on the Sheet tab that you want to protect, and select view code. Delete the code that is placed by default and insert this. Change to your needs....

Private Sub Worksheet_Activate()

Dim s As String

Const SheetPass = "protect"
Const Pass1 = "test"
Const Pass2 = "this"

Me.Protect Password:=SheetPass, DrawingObjects:=True, Contents:=True, _
    Scenarios:=True, UserInterfaceOnly:=True

s = InputBox("Please input your password.", "Password Input")

If s <> vbNullString Then

    If s = Pass1 Then
        Me.[A1].Locked = False
    ElseIf s = Pass2 Then
        Me.[A2].Locked = False
    End If

End If

End Sub

Private Sub Worksheet_Deactivate()

Me.[A1].Locked = True
Me.[A2].Locked = True

End Sub

Post Tue Jul 22, 2003 1:08 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

Derek
Board Master


Joined: 17 Feb 2002
Posts: 637
Location: Perth Australia
Flag: Australia

Status: Offline

 Reply with quote  

Re: Password protection

Hi there

Another alternative, (not as sophisticated), which only allows a value change in a specific cell. Works on the doubleclick event macro (after pasting into the vb editor for the sheet, the password prompt is activated by doubleclicking any cell.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
answer = InputBox("Enter Password", "PASSWORD PROTECTED")
If answer = "password1" Then
ActiveSheet.Unprotect "password3"
[G4].Value = InputBox("enter new value for cell G4", "CHANGE VALUE IN G4")
ActiveSheet.Protect "password3"
Else
If answer = "password2" Then
ActiveSheet.Unprotect "password3"
[G4].Value = InputBox("enter new value for cell G4", "CHANGE VALUE IN G4")
ActiveSheet.Protect "password3"
Else
ActiveSheet.Protect "password3"
Exit Sub
End If
End If
End Sub


regards
Derek

Post Tue Jul 22, 2003 1:23 pm 
 View user's profile Send private message

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

icon_banghead.gif icon_banghead.gif

Tommygun - which codes are you referring to when you say to delete the default codes. I could not get the code to work for me yet.

Derek - Where do you set the passwords to get into the cell. I tried your code out and anything that I typed in for the password seemed to work?

Thank you to both....

icon_pray.gif

Post Tue Jul 22, 2003 1:43 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

The code should go on the Worksheet object (ie Sheet1). How is the code not working???

Post Tue Jul 22, 2003 1:57 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

I am not getting a password prompt for cells a1 or a2 and if I am understanding the code correctly there is not an input box coming up either. I am free to type anything in the two cells.

Post Tue Jul 22, 2003 2:10 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Where did you place the code?

Post Tue Jul 22, 2003 2:12 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

I placed the code at the beginning of sheet 1 codes.

Post Tue Jul 22, 2003 2:17 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Okay, I will email you a sample.

Post Tue Jul 22, 2003 2:17 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

I have this so far:

Private Sub Workbook_Open()
Dim S As String
Const SheetPass = "protect"
Const Pass1 = "test"
Const Pass2 = "this"
S = InputBox("Please input your password.", "Password Input")
If S <> vbNullString Then
If S = Pass1 Then
Sheets("Sheet1").Range("C8").Locked = False
Sheets("Sheet1").Range("F8").Locked = True
ElseIf S = Pass2 Then
Sheets("Sheet1").Range("F8").Locked = False
Sheets("Sheet1").Range("C8").Locked = True
End If
End If
End Sub

Now I would like to add the following sub to it in order to shut down the other cell i.e. if I want C8 make F8 off limits and vice versa:

Private Sub WorkSheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Address = [A1].Address Then
MsgBox "Don't touch me!"
Application.Undo
End If
End Sub

I realize the second is for a particular worksheet, but I would like to add it in the workbook level in order to stop in at the beginning.

Thanks a lot Tommy Gun for your help thus far.

David

Post Tue Jul 22, 2003 5:43 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Why wouldn't you use the Worksheet_Activate/Deactivate combination that was sent in the sample? How does this not work for you?

Post Tue Jul 22, 2003 5:51 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

I decided that I wanted to have the security on the workbook level instead of the worksheet level. I converted the activate and deactivate over from worksheet to workbook and it works great except for not shuting down the second cell. Hopefully that makes sense.

Post Tue Jul 22, 2003 5:55 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Okay well here's the code you requested on the Workbook level. Not sure what you want from it though...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

If Sh.Name = "Sheet1" Then

    Application.EnableEvents = False
    
    If Target.Address = [A1].Address Then
        MsgBox "Don't touch me!"
        Application.Undo
    End If

    Application.EnableEvents = True

End If

End Sub
icon_huh.gif

Post Tue Jul 22, 2003 6:01 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

Thank you Tommy Gun.

My CFO is very particular that is why I moved it up to the book level from the sheet level.

Again thank you.

Post Tue Jul 22, 2003 6:51 pm 
 View user's profile Send private message Send e-mail

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

Hopefully this is the last time. I have the first two parts working, its just this third part that I am having trouble with. I need for the two cells C8 and F8 to be locked if both have true, with a statement to pop up also.

ElseIf Sheets("Sheet1").Range("C8").Locked = True And Sheets("Sheet1").Range("F8").Locked = True Then
If Sh.Name = "Sheet1" Then
Application.EnableEvents = False
If Target.Address = [C8].Address Then
MsgBox "You don't have the authority to change the data."
Application.Undo
If Target.Address = [F8].Address Then
MsgBox "You don't have the authority to change the data."
Application.Undo
End If
End If
Application.EnableEvents = True
End If
End If
End Sub


Thank you in advance.

Post Wed Jul 23, 2003 12:17 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Maybe this is what you are looking for...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

If Sh.Name = "Sheet1" Then

    Application.EnableEvents = False

    With Sh
    
        If Target.Address = .[A1].Address Then
            MsgBox "Don't touch me!"
            Application.Undo
        ElseIf (.[C8].Locked And .[F8].Locked) Then
            Select Case Target.Address
                Case .[C8].Address, .[F8].Address
                    MsgBox "You don't have authority to change the data."
                    Application.Undo
            End Select
        End If

    End With

    Application.EnableEvents = True

End If

End Sub

Post Wed Jul 23, 2003 12:32 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

Here is the complete sub, I couldn't get the sub that you gave me Tommy to work within my sub by removing the sub line. So here it is so you can see it all.

Private Sub WorkBook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
If Sheets("Sheet1").Range("C8").Locked = False And Sheets("Sheet1").Range("F8").Locked = True Then
If Sh.Name = "Sheet1" Then
Application.EnableEvents = False
If Target.Address = [F8].Address Then
MsgBox "You don't have the authority to change the data."
Application.Undo
End If
Application.EnableEvents = True
End If
ElseIf Sheets("Sheet1").Range("F8").Locked = False And Sheets("Sheet1").Range("C8").Locked = True Then
If Sh.Name = "Sheet1" Then
Application.EnableEvents = False
If Target.Address = [C8].Address Then
MsgBox "You don't have the authority to change the data."
Application.Undo
End If
Application.EnableEvents = True
End If
ElseIf Sheets("Sheet1").Range("C8").Locked = True And Sheets("Sheet1").Range("F8").Locked = True Then
If Sh.Name = "Sheet1" Then
Application.EnableEvents = False
If Target.Address = [C8].Address Then
MsgBox "You don't have the authority to change the data."
Application.Undo
If Target.Address = [F8].Address Then
MsgBox "You don't have the authority to change the data."
Application.Undo
End If
End If
Application.EnableEvents = True
End If
End If
End Sub

Sorry for being so much trouble Tommy Gun. icon_pray.gif icon_banghead.gif icon_huh.gif

Post Wed Jul 23, 2003 1:00 pm 
 View user's profile Send private message Send e-mail

TommyGun
MrExcel MVP


Joined: 10 Dec 2002
Posts: 3397
Location: Clear Lake, TX
Flag: Usa

Status: Offline

 Reply with quote  

Re: Password protection

Ok, replace your entire code with this...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

If Sh.Name = "Sheet1" Then

    Application.EnableEvents = False

    With Sh

        If (Not .[C8].Locked And .[F8].Locked) Then
            If Target.Address = .[F8].Address Then
                MsgBox "You don't have the authority to change the data."
                Application.Undo
            End If
        ElseIf (.[C8].Locked And Not .[F8].Locked) Then
            If Target.Address = .[C8].Address Then
                MsgBox "You don't have the authority to change the data."
                Application.Undo
            End If
        ElseIf (.[C8].Locked And .[F8].Locked) Then
            Select Case Target.Address
                Case .[C8].Address, .[F8].Address
                    MsgBox "You don't have authority to change the data."
                    Application.Undo
            End Select
        End If

    End With

    Application.EnableEvents = True

End If

End Sub

Post Wed Jul 23, 2003 1:06 pm 
 View user's profile Send private message AIM Address Yahoo Messenger MSN Messenger

dgrimm68
Board Regular


Joined: 16 Jul 2002
Posts: 17


Status: Offline

 Reply with quote  

Re: Password protection

Thank you Tommy Gun

That worked great.

Post Wed Jul 23, 2003 1:17 pm 
 View user's profile Send private message Send e-mail
  Display posts from previous:      

MrExcel Message Board Forum Index -> Excel Questions


Forum Jump:
Jump to:  

Post new topic   Reply to topic
Page 1 of 1



Add To Favorites

 


Forum Rules:
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum

Powered by phpBB: 2.0.4 © 2001 phpBB Group

Need help posting your first question? Read how to post

Need extra help ? Couldn't get the answer you needed ? Get a free quote from our Consulting Team

Download Colo's HTML Maker utility for displaying your Excel Worksheet on the board.

Download VB HTML Maker to post your code on the board


Check out our new index to 485 Excel Articles.


Return to MrExcel Consulting

All contents Copyright 1998-2004 by MrExcel.com
If you believe information posted here is from your copyrighted source, notify us per the Terms of Use
Excel is a registered trademark of the Microsoft Corporation.
MrExcel is a registered trademark of Tickling Keys, Inc.