Reputation: 214
I thought this would be a readily used function in Excel but it's surprisingly difficult to implement a simple process of restricting access to specific worksheets within a larger workbook.
There's a few methods that prompt an initial password to open various versions of the same workbook. But I want to keep the workbook identical for all users but restrict access to certain sheets. Surely there's a password protect function that requires the user to enter a password to view a sheet. Rather than create multiple versions of the same workbook based on different users.
I have tried the following but it doesnt prompt a password to access the sheet
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
Dim MySheet As Worksheet
MySheet = "COMMUNICATION"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
Am I doing this right?
Upvotes: 10
Views: 5864
Reputation: 10139
It sounds like according to the comments that this isn't as much as a security issue as it is a convenience issue. So please bear in mind when considering implementing this into your project that this is easily breakable if there is any malicious intent to gain unauthorized access.
First, I would recommend a common landing zone. A main worksheet that is displayed immediately after opening a workbook. To do this, we would use the Workbook_Open()
event and activate a sheet from there.
This can be a hidden sheet if desired, that will be up to you.
Option Explicit
Private lastUsedSheet As Worksheet
Private Sub Workbook_Open()
Set lastUsedSheet = Me.Worksheets("MainSheet")
Application.EnableEvents = False
lastUsedSheet.Activate
Application.EnableEvents = True
End Sub
Next, we should decide on what should occur when there's an attempt to access a new sheet. In the below method, once a sheet is activated it will automatically redirect the user back to the last used sheet until a successful password attempt has been made.
We can track the last used sheet in a module-scoped variable, which in this example will be named lastUsedSheet
. Any time a worksheet is successfully changed, this variable will be set to that worksheet automatically - this way when when someone attempts to access another sheet, it will redirect them back to the prior sheet until the password is successfully entered.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error GoTo SafeExit
Application.EnableEvents = False
' Error protection in case lastUsedSheet is nothing
If lastUsedSheet Is Nothing Then
Set lastUsedSheet = Me.Worksheets("MainSheet")
End If
' Allow common sheets to be activated without PW
If Sh.Name = "MainSheet" Then
Set lastUsedSheet = Sh
Sh.Activate
GoTo SafeExit
Else
' Temporarily send the user back to last sheet until
' Password has been successfully entered
lastUsedSheet.Activate
End If
' Set each sheet's password
Dim sInputPW As String, sSheetPW As String
Select Case Sh.Name
Case "Sheet1"
sSheetPW = "123456"
Case "Sheet2"
sSheetPW = "987654"
End Select
' Create a loop that will keep prompting password
' until successful pw or empty string entered
Do
sInputPW = InputBox("Please enter password for the " & _
"worksheet: " & Sh.Name & ".")
If sInputPW = "" Then GoTo SafeExit
Loop While sInputPW <> sSheetPW
Set lastUsedSheet = Sh
Sh.Activate
SafeExit:
Application.EnableEvents = True
If Err.Number <> 0 Then
Debug.Print Time; Err.Description
MsgBox Err.Description, Title:="Error # " & Err.Number
End If
End Sub
Side note, disabling events is necessary due to the fact that your Workbook_SheetActivate
event will continue to fire after a successful sheet change.
SaveAs
1You can further protect the accidental removal of VBA code by restricting the file save type. This can be accomplished using the Workbook_BeforeSave()
event. The reason this is a potential problem is that saving as a non-macro enabled workbook will erase the code, which will prevent the password protection features you just implemented above.
First, we need to check if this is a Save
or SaveAs
. You can accomplish this using the Boolean property SaveAsUI
that is included with the event itself. If this value is True
, then it's a SaveAs
event - which means we need to perform additional checks to ensure that the file type isn't accidentally changed from the save dialog box. If the value is False
, then this is a normal save, and we can bypass these checks because we know the workbook will be saved as type .xlsm
.
After this initial check, we will display the dialog box using Application.FileDialog().Show
.
Afterwards, we will check if the user canceled the operation .SelectedItems.Count = 0
or clicked Save. IF user clicked cancel, then we simply set Cancel = True
and the workbook will not save.
We proceed to check the type of extension selected by the user using this line:
If Split(fileName, ".")(UBound(Split(fileName, "."))) <> "xlsm" Then
This will split the file path by a period .
, and will grab the last instance of the period (UBound(Split(fileName, ".")))
in the event a file name may contain additional periods. If the extension does not match xlsm
, then we abort the save operation.
Finally, after all checks passed, you can save the document:
Me.SaveAs .SelectedItems(1), 52
Since we already saved it with the above line, we can go ahead and set Cancel = True
and exit the routine.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo SafeExit
If SaveAsUI Then
With Application.FileDialog(msoFileDialogSaveAs)
.Show
If .SelectedItems.Count = 0 Then
Cancel = True
Else
Dim fileName$
fileName = .SelectedItems(1)
If Split(fileName, ".")(UBound(Split(fileName, "."))) <> "xlsm" Then
MsgBox "You must save this as an .xlsm document. Document has " & _
"NOT been saved", vbCritical
Cancel = True
Else
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs .SelectedItems(1), 52
Cancel = True
End If
End If
End With
Else
Exit Sub
End If
SafeExit:
Application.EnableEvents = True
Application.DisplayAlerts = True
If Err.Number <> 0 Then
Debug.Print Time; Err.Description
MsgBox Err.Description, Title:="Error # " & Err.Number
End If
End Sub
1 Shoutout to PatricK for the suggestion
Upvotes: 7
Reputation: 2777
I concur with Mathieu Guindon that any VBA attempt to "Restrict viewing access to an Excel worksheet" will be flimsy as explained by Mathieu Guindon. Moreover, If the file is opened with Excel option Macro security level other than the lowest, any VBA code including this is bound to fail.
However just for shake of simplicity I prefer to use workbook open event and Sheet Activate of the restricted sheet. Using Workbook Sheet Activate event will trigger password prompt even during switching between sheets by user with viewing access.
Private Sub Workbook_Open()
Sheets("COMMUNICATION").Visible = xlSheetHidden
End Sub
Public ViewAccess As Boolean 'In restricted sheet's activate event
Private Sub Worksheet_Activate()
If ViewAccess = False Then
Me.Visible = xlSheetHidden
response = Application.InputBox("Password", xTitleId, "", Type:=2)
If response = "123" Then
Me.Visible = xlSheetVisible
ViewAccess = True
End If
End If
End Sub
Upvotes: 0
Reputation: 473
If you want to restrict access to a worksheet, you can just hide it:
ActiveWorkbook.Sheets("YourWorkSheet").Visible = xlSheetVeryHidden
Upvotes: 2