I am looking for a way that will unprotect a spreadsheet only if the computer
user name matches a list of approved users and then protect that sheet again
when they exit. Thank you in advance for any help!

I'm going to presume you mean by the name that they log into their systems
with? If so this will do it. If not, I'll probably add another post showing
how to ask for name and validate it.

This code has to be placed into two different areas. One small segment, the
declaration for the API call has to go into a regular code module. I'll
assume you don't have an existing module available for use. In Excel press
[Alt]+[F11] to get into the VB Editor and then choose Insert | Module and
copy and paste this into that module:


'this must be placed in a regular code module:
'[Alt]+[F11] to open the VB Editor,
'use Insert | Module once in the VB Editor and
'copy and paste the definition below into the
'presented module.
' Use GetUserNameA function in advapi32.dll
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long


After you've done that, then look in the window titled Project - VBAProject
and double-click on the worksheet in the list (you may have to expand the
list of Microsoft Excel Objects to see it). That will open up the code
module for that sheet. Copy and paste the code below into that worksheet
code module, then adapt the list to contain valid user login names. Note
that this is looking for the userID they use to log into Window. Be sure and
set the password properly also.

Const theWorksheetPassword = "myPassword"

Private Sub worksheet_Activate()
Dim anyUser As String
Dim LC As Integer ' loop counter
'adjust these as needed
Dim validUsers(1 To 5) As String
'set up list of valid users in the array
validUsers(1) = "jlatham"
validUsers(2) = "me"
validUsers(3) = "ralphie"
'you can have leftovers if you want

anyUser = GetCurrentUser_Name()
'just to show how it works
MsgBox "Current username is: " & anyUser
'your code to compare the results to valid list here,
'if no match the sheet remains protected.
For LC = LBound(validUsers) To UBound(validUsers)
If validUsers(LC) = anyUser Then
ActiveSheet.Unprotect Password:=theWorksheetPassword
'valid user, exit
Exit Sub
End If
Next
'anyUser doesn't match list of valid users,
'just leave it locked up.
End Sub

Private Sub Worksheet_Deactivate()
'you can record a macro while protecting the sheet
'with options you need and copy and paste the code
'from it into this routine and add the password:= parameter to
'that command.
ActiveSheet.Protect DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
Password:=theWorksheetPassword
End Sub

Private Function GetCurrentUser_Name() As String
Dim lpBuff As String * 25
Dim ret As Long

' Get the user name minus any trailing spaces found in the name.
ret = GetUserName(lpBuff, 25)
GetCurrentUser_Name = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function

"wagz" wrote:

I am looking for a way that will unprotect a spreadsheet only if the computer
user name matches a list of approved users and then protect that sheet again
when they exit. Thank you in advance for any help!

CHAPTER 2: How to do it by requesting input from the user. This one does not
required the definition for the API call, just use the code below in the
worksheet's code module: From Excel, right-click on the sheet's name tab and
choose View Code from the list and then copy, paste and modify the code into
the module that appears.

Once a user has opened and gained access to this worksheet once, they will
retain access to it without again having to re-enter their userID until they
close the workbook and reopen it.

Keep in mind that this whole process can be circumvented by the simple
action of holding down the [Shift] key while opening the workbook (prevents
any macros from running), or they could even hit [ctrl]+[break] when being
asked for their input. Since the worksheet's password is in clear text in
the code itself, you may want to also password protect your VBA Project. Be
sure to write down the password for that somewhere so you don't forget it if
you do that. It will help prevent people from examining the code and seeing
either the worksheet's password or the list of valid users. To do that, in
the VB Editor, choose Tools VB Project Properties and go to the Protection
tab and set things up there. As I said, be sure and keep a copy of the
password you used somewhere - if you forget it, you're going to be locked out
of modifying the code in the future.


Const theWorksheetPassword = "myPassword"

Private Sub worksheet_Activate()
Static anyUser As String
Dim LC As Integer ' loop counter
'adjust these as needed
Dim validUsers(1 To 5) As String
'set up list of valid users in the array
validUsers(1) = "jlatham"
validUsers(2) = "me"
validUsers(3) = "ralphie"
'you can have leftovers if you want

If anyUser = "" Then
anyUser = InputBox("Enter your user ID:", _
"To Unlock Sheet", "")
If anyUser = "" Then
Exit Sub ' just exit, leaving workbook locked
End If
End If
'your code to compare the results to valid list here,
'if no match then simply use
' ThisWorkbook.Close to shut things down on them
'test for match, when you find one, it's a valid
'user, just exit the sub. But if the loop
'completes without a match, then the workbook will close
For LC = LBound(validUsers) To UBound(validUsers)
If validUsers(LC) = anyUser Then
ActiveSheet.Unprotect Password:=theWorksheetPassword
'valid user, exit
Exit Sub
End If
Next
'anyUser doesn't match list of valid users,
'just leave it locked up.
End Sub

Private Sub Worksheet_Deactivate()
'you can record a macro while protecting the sheet
'with options you need and copy and paste the code
'from it into this routine and add the password:= parameter to
'that command.
ActiveSheet.Protect DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
Password:=theWorksheetPassword
End Sub



"wagz" wrote:

I am looking for a way that will unprotect a spreadsheet only if the computer
user name matches a list of approved users and then protect that sheet again
when they exit. Thank you in advance for any help!