password protection via code

G

Guest

Can anyone tell me where I am going wrong here? I have a multisheet workbook
that will be used by several people. I want to protect each sheet with a
password that will be based on the user. Each user's sheets will have a
similar naming criteria (e.g. Jenn's sheets will be named "PR.....", Riki's
will all be "CF....", etc.). I have code that looks at each sheet's name and
protects each sheet. However, I can't seem to get the password to be
applied. Also, the section that checks for protection isn't working, either

Any ideas? Here is the code I am using. I want to put this in the
Before_Close of the This Workbook...

Sub pword()

Dim I As Integer, ii As Integer, iSheets As Integer
Dim NN As String

iSheets = ActiveWorkbook.Sheets.Count

For ii = 1 To iSheets - 1 ' I don't want the last sheet protected here
Sheets(ii).Activate
If ActiveWorkbook.ActiveSheet.Protect = True Then GoTo skipme
'If sheet is already protected, don't bother
Select Case Left(ActiveWorkbook.ActiveSheet.Name, 2)
Case "PR"
NN = "jenn"
Case "CF"
NN = "riki"
Case "SD"
NN = "tric"
Case "LD"
NN = "luda"
Case Else
GoTo skipme
End Select

ActiveWorkbook.ActiveSheet.Protect Password:=NN, DrawingObjects:=True,
Contents:=True, Scenarios:=True

skipme:

Next ii

End Sub
--
Thanks in advance,

Bruce
swatsp0p
The older I get, the better I used to be.
 
H

Helmut Weber

Hi,

works allright for me here and now.
Of course,

select Case Left(ActiveWorkbook.ActiveSheet.Name, 2)
Case "PR"

is case sensitive.

--

Helmut Weber

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
D

Dave Peterson

It looks like you want to loop through the worksheets--but your code is always
looking at the activesheet.

Option Explicit
Sub pword()

Dim I As Long
Dim ii As Long
Dim iSheets As Long
Dim NN As String

iSheets = ActiveWorkbook.Sheets.Count

For ii = 1 To iSheets - 1 ' I don't want the last sheet protected here
NN = ""
With Sheets(ii)
If .ProtectContents _
Or .ProtectDrawingObjects _
Or .ProtectScenarios Then
'already protected
Else
Select Case UCase(Left(.Name, 2))
Case "PR"
NN = "jenn"
Case "CF"
NN = "riki"
Case "SD"
NN = "tric"
Case "LD"
NN = "luda"
End Select
End If
If NN = "" Then
'not in the list or already protected.
Else
.Protect Password:=NN, _
DrawingObjects:=True, Contents:=True, _
Scenarios:=True
End If
End With
Next ii

End Sub
 
D

Dave Peterson

And I missed the part where you were activating the sheet. But checking the
protection is different from what you used, too.
 
G

Guest

Thanks, Dave. Not sure how I missed that. I appreciate your help (as always).

Thanks to Helmut, too.
 
G

Guest

Whatever it was, it works now. I'm guessing the checking for protection
gummed up the works. Thanks again.
--
The older I get, the better I used to be.


Dave Peterson said:
And I missed the part where you were activating the sheet. But checking the
protection is different from what you used, too.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top