VB CODE for password protected sheet to release part of the worksh

[CAPTGNVR]

DEAR ALL

I have a protected worksheet where various departments have to enter the data.

What I need is to release the respective named ranges to the respective
departments to make data entry.

One way I thought was to restrict the scroll area and give a command button
to unprotect. But there is room for mischief as other dept can unprotect and
change the data. Also thought of giving passwords and getting users input
from input box and release the sheet. But unable to assign password for
particular named range.

So if the sheet is protected, and if Charlie has to change data in the named
range charlie_range, how can I provide an indiviudal password to Charlie and
like wise to each dept for their named range. Hope I got my need explained.

Can anyone suggest / help me pls?

brgds/captgnvr

 

[paul.robinson]

Hi
You might be able to use the Worksheet_SelectionChange event.
1. Give each Dept separate passwords. If any put in, unprotect the
sheet.
2. Save the password inputted, either as a public variable, name or on
a hidden sheet.
3. In the Worksheet_SelectionChange event check that the selected cell
is allowed for that password

e.g. Pseudocode
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim DeptRange(1 to 3) as Range
Dim DeptPassword(1 to 3) as String
Set DeptRange(1) = Range("A1:B2")
Set DeptRange(2) = Range("C12")
Set DeptRange(3) = Range("E1:F2")
DeptPassword(1) = "X"
DeptPassword(2) = "Y"
DeptPassword(3) = "Z"
For i = 1 to 3 'check input password is for this range
If DeptPassword(i) = inputted_password then
DeptArea = i
Exit for
end if
next i
If intersect(Target, DeptRange(DeptArea)) is nothing then
msgbox "You cannot change this cell value, but only cells " &
DeptRange(DeptArea).Address
end if
End Sub

regards
Paul

 

[CAPTGNVR]

D/PAUL

I went thro ur code and explanations on the mind and it seems very
convincing. I would have to fit it in the project and get back. Due to
tight schedule I wl be doing it soon in a day or two.

In the mean time pls guide me as there is no code to ask for password for
that dept head to input . How will the inputted password be checked without a
code for dept head to input his code?? I guess I have to make one line with
inputbox and get the password?? Pls suggest

Thanks for the quick response n brgds/captgnvr

 

[CAPTGNVR]

D/PAUL

I tried your code and encountered below blockades:

1. One minor line continuation missing for the msgbox code after "&".

2, without inputbox to get the password, subscript error comes.

3. If click 'cancel' gives subscript error.

4. This is most vital--NOW anyhwere I click on the sheet it asks for
password. What I need is to prompt for password only when the dept1 area is
clicked or dept2 or the case may be and rest of the area it should not ask
for as I have left the cells unprotected for entry which is common to all.

Looking forward to n brgds/captgnvr

subscript error was coming and

 

[paul.robinson]

Hi
I only sent you an idea for some code, and didn't expect it to work as
is!

1. You must capture a password to unprotect the sheet. Suppose the
real password is "fred". You give out other passwords for each Dept
"X", "Y" and "Z". Your macro for the unprotect button on the sheet
would now be

Public inputted_Password as String 'a public variable

Sub UnprotectIt()
inputted_Password = inputbox("What is your Department Password")
if inputted_Password = "X" or inputted_Password = "Y" or
inputted_Password = "Z" then
Activesheet.Unprotect password:="fred"
else
msgbox "That is not a valid password"
end if
End Sub

You have now unprotected the sheet and captured "X", "Y" or "Z" as a
public variable, which will live as long as the workbook is open.

Now to restrict the input range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim DeptRange(1 to 3) as Range
Dim DeptPassword(1 to 3) as String
Set DeptRange(1) = Range("A1:B2")
Set DeptRange(2) = Range("C12")
Set DeptRange(3) = Range("E1:F2")
DeptPassword(1) = "X"
DeptPassword(2) = "Y"
DeptPassword(3) = "Z"
For i = 1 to 3 'check input password is for this range
If DeptPassword(i) = inputted_Password then
DeptArea = i
Exit for
end if
next i
If intersect(Target, DeptRange(DeptArea)) is nothing then
msgbox "You cannot change this cell value, but only cells " & _
DeptRange(DeptArea).Address
end if
End Sub

See if this works
regards
Paul

 

[CAPTGNVR]

D/PAUL

Was eagerly waiting for further guidance. With the start you gave, I have
made quite a lot of progress. referred to help n i have gotten a fair
knowledge of how to go about, thanks to your start.

The irritant now is, for each cell in the range after entering data and on
hittting enter, I have to enter the dept password.

Can u pls tell me if there is a way where I can get to release the whole
range for the department rather than type password for each entry of the cell.

I was touched by the time and coding u hv sent with explanation and but for
it I would not have understood it so well. Thank u v much.

brgds/captgnvr

 

[paul.robinson]

Hi
There is nothing in my code which would keep asking for the password,
so it is something you have introduced.
Post your code so far and I'll have a look. I suspect you have put the
code asking for the password inside the change event


regards
Paul

 

[CAPTGNVR]

D/PAUL

U are right. I put the password input in the change event. Now all fine
and thanks for following it up. Now based on your start, i hv marked the
area with scroll area limitation and when that area is needed, the dept has
to enter their password and it works a charm.

This thread can be considered closed with many thanks and appreciation for
ur time and patent explanations.

brgds/captgnvr

 

[paul.robinson]

Thanks
Paul

D/PAUL

U are right. I put the password input  in the change event.  Now all fine
and thanks for following it up.  Now based on your start, i hv marked the
area with scroll area limitation and when that area is needed, the dept has
to enter their password and it works a charm.

This thread can be considered closed with many thanks and appreciation for
ur time and patent explanations.

brgds/captgnvr





- Show quoted text -