Un-protect sheet for specific user

[pr1asd]

Hi,

Sorry to be a pain for my first post. I have already been able to do most of the work for this project based on advice from this site (I'm not a programmer so I have resorted to borrowing code and pasting in where it needs to go to make my excel VBA) so Thank you to everyone.

So far, I have managed to make sure that the users have to turn on macros to be able to see anything, prevent copying, pasting etc and prevent users from inserting another worksheet into the work book (yet again all from help on this site).

I have also included a function to display the windows username in a sheet using Environ("USERNAME").

But now I have got stuck.... Instead of the users having to set a password for the only sheet they can access, I want VBA to unprotect the worksheet for certain users only.

I have tried searching the VBAexpress forum for days now, but have not been able to find anything that works (mostly because searching for "user protect" brings up so many hits).

I thought having the following code in the "sheet" section may have worked, but, when I save the workbook I get a compiler error (Invalid outside procedure) on the "USERNAME" section of the code. (I know the code says that if the user name is "User" then it should protect the active sheet. I done this to test if it would work)


If Environ("USERNAME") = "User" Then
ActiveSheet.Protect
Else
ActiveSheet.Unprotect
End If


Initially, there will be only 4 users who should be able to edit the sheet. Hence why I have gone for a simple system such as this.

In the future, I plan to add another level of security such that if the user "admin" is logged in then they can add or remove user names from a sheet (and only add or remove user names from a sheet).

Any user listed on that sheet will have full access to edit the sheet (un-protected) while everyone else would not be able to edit the sheet (protected).

I have attached the excel sheet for anyone to have a look at the code and structure so far (just in case it comes in handy) or to help others point me in the right direction.

I hope this make sense....

Thank you for any help in advance.

[Rob342]

Pr
Have taken a quick look, there are some problems with the way you are implementing the code.
You need to leave 1 tab visible otherwise you will get errors its better to hide all sheets with the workbook open event 1st.
You could have a form with the password to allow each staff to access only parts of the Wb.
or you could hard code it in & carry out case statements on each of the password or build it into an array all depends how much work & updating you want to do.

Just my thoughts.
Rob

[pr1asd]

Hi Rob,

Thanks for the quick reply and your advice.

There is always 1 work sheet open. Initially, this is the ws informing the user to enable macros. If macros are enabled, then it is ws with the data.

I wanted to move away from using a password as most of the staff already have a lot of passwords and numbers to remember (some of these change monthly). If I could link access to the windows username, it means that the user access could be restricted without having to remember another password (plus everyone that will have write access to the sheet locks their computer when they are away from their desk).

Like I said, I'm sorry to be such a pain with my first problem.

Thanks

[Rob342]

Pr
Do you want to try this, change to suit your sheets as req

Private Sub User_Name()
MsgBox "Current user is " & Application.UserName ' rem out msgbox when req
If Application.UserName = "John" Then
Worksheets("Sheet1").Visible = True
Else
If Application.UserName = "Rod" Then
Worksheets("Sheet1").Visible = True And Worksheets("Sheet2").Visible = True
Else
If Application.UserName = "Administrator" Then
Worksheets("Sheet1").Visible = True And Worksheets("Sheet2").Visible = True _
And Worksheets("Sheet3").Visible = True

' etc etc etc & so on

End If
End If
End If
End Sub

[pr1asd]

Hi Rob,

Thanks for the advice.

Based on your advice, I have changed the code to below:

If Range("A1") = "admin" Then
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Users Info" Then ws.Visible = xlSheetVeryHidden
Next ws
Call ClearA1
Else
'display Approved Suppliers worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Approved Suppliers" Then ws.Visible = xlSheetVeryHidden
Next ws
End If


The reason for the "xlSheetVeryHidden" is because that was in the macro I used to help hide all the other sheets and display the "please enable macro" sheet.

I then have the following code for applying or removing sheet protection:


If Range("A1") = "User1" Then
Else
If Range("A1") = "User2" Then
Call ClearA1
Else
If ("A1") = "User3" Then
Call ClearA1
Else
If ("A1") = "User4" Then
Call ClearA1
Else
End If
End If
End If
Call ClearA1
Call SheetProtect
Call ToggleCutCopyAndPaste(False)
End If


Where ClearA1 is:

Sub ClearA1()
Range("A1").Select
Selection.ClearContents
End Sub


Sheet protect is:

Sub SheetProtect()
ActiveSheet.Unprotect "password"
End Sub


This is okay for the moment, but I would appreciate your advice on how to make the code better.

Thanks again.

Aman

[Rob342]

Aman

Dont use "select" if you can help it ie Range("A1").Select
Instead of selecting the range 1st then doing something just use
Range("A1").ClearContents instead

Without seeing all the code can't really comment.
Did the Application.UserName work

Rob

[pr1asd]

Hi Rob,

I tried the Application.UserName. This bought up the name I had originally used when I first started excel (tried on the home computer). However, I know that I have there have been times at work where one computer would have one name and another would have a different one (I could not be bothered to enter my full name on the computers that I do not use every time).

But my windows username is consistent throughout the company.

For this reason, I found this code somewhere (cannt remember if it was VBAX or another website) and introduced another sheet called "User" where this can be run to find out the username of the person logged in. The code below also includes the code written to execute the function in A1 (written by recording a macro)


Function UNameWindows() As String
UNameWindows = Environ("USERNAME")

End Function
'macro to insert the current username in A1
'The username will then be pasted in white
Sub usernamewhite()
Range("A1").Select
ActiveCell.FormulaR1C1 = "=unamewindows()"
Range("A1").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
End Sub


The next part is to take out the if "user1" then, if "user2" then, etc, etc.... and change it so that the program will search for the UNameWindows in the "Users Info" sheet in order to decide if the "Approved Suppliers" sheet is protected or not.

I am currently searching VBAX to help me with this, but any pointers would be appreciated.

Thanks

Aman

P.S. Updated sheet attached.

P.P.S There seems to be a problem closing the workbook when the sheet is saved by a user that is viewing a protected sheet. This will be the next problem for me to solve....Im thinking of preventing save, until the workbook is closed....but one step at a time.

[macropod]

FWIW, I'd approach the workbook initialization along these (untested) lines:
Sub Demo()
Dim strUsers As String, StrWkShts As String, i As Long
With ThisWorkbook
'Activate the first worksheet
.Worksheets(1).Activate
' Turn off screen updating
Application.ScreenUpdating = False
'Hide all the other worksheets
For i = 2 To .Worksheets.Count
.Worksheets(i).Visible = xlSheetVeryHidden
Next
' Restore screen updating
Application.ScreenUpdating = True
' Retrieve the user list
With .Worksheets("Users Info")
For i = 2 To .UsedRange.Rows.Count
strUsers = strUsers & " " & Chr(34) & .Cells(i, 1).Value & Chr(34)
Next
End With
strUsers = Replace(Trim(strUsers), " ", ", ")
' Check who the user is, and process
Select Case Environ("USERNAME")
Case strUsers
StrWkShts = "Sheet1,Sheet4,Sheet6"
Case "John", "George", "Paul", "Ringo"
StrWkShts = "Beatles"
Case "Boss"
StrWkShts = "Sheet1,Sheet4,Sheet6"
Case "Admin"
StrWkShts = "Users Info"
Case Else
MsgBox "Go away", vbExclamation
Exit Sub
End Select
' Reveal worksheets applicable to valid users
For i = 0 To UBound(Split(StrWkShts, ","))
.Worksheets(Split(StrWkShts, ",")(i)).Visible = True
Next
End With
End Sub