Adapting VBA code with runtime error 13 on array

BlissC

New Member
Joined
Aug 28, 2017
Messages
47
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I'm developing an annual leave card which I need to hide certain pages of to prevent employees from authorising their own leave requests. I know it's not super-secure, but really I just need the pages not to show - just to keep the casual user from seeing the pages when the file's opened.

The VBA I'm trying to adapt is from this thread: Password protecting a checkbox (the original issue was about password protecting a checkbox to show/hide the pages which has now evolved into using the username to allow/disallow access, so the original thread title isn't really relevant to my current issue, hence the new thread - I'll post a link to this thread in the other though).

The leave card has the pages: Welcome, Leave, Configuration, Authorisation, List Configuration, Access, Changelog.

The pages 'Authorisation', 'List Configuration', 'Access', and 'Changelog' are visible only to specified managers and admin staff. In this original VBA their names are hard-coded into the VBA, and the pages that are restricted are from a range on the 'Access' page.

This is the original VBA which member Eric W kindly provided:

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cell As Range

    For Each cell In Sheets("Access").Range("C9:C12")
        ActiveWorkbook.Worksheets(cell.Value).Visible = xlVeryHidden
    Next cell
    
End Sub

Private Sub Workbook_Open()
Dim cell As Range, ManagerNames As Variant

    ManagerNames = Array("Andrew Grainger", "Cathy Jones", "Paul Stepto", "Vanessa Watson", "Louise Fletcher", "Sam Naylor", "Rachel Turner")
    If UBound(filter(ManagerNames, Application.UserName)) < 0 Then Exit Sub
    
    For Each cell In Sheets("Access").Range("C9:C12")
        ActiveWorkbook.Worksheets(cell.Value).Visible = True
    Next cell
    
End Sub

This is working fine, but as it means that the leave request page and configuration are visible to anyone who opens the file, I wanted to restrict these two pages to the ManagerNames group already specified, and the employee whose leave card it is. I've managed to accompany this by simply repeating the code and tweaking the name of the Private Sub slightly, but I'm sure it's not the most efficient way of doing it (result below).

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cell As Range

    For Each cell In Sheets("Access").Range("C9:C12")
        ActiveWorkbook.Worksheets(cell.Value).Visible = xlVeryHidden
    Next cell
    
End Sub

Private Sub Workbook_Open()
Dim cell As Range, ManagerNames As Variant

    ManagerNames = Array("Andrew Grainger", "Cathy Jones", "Paul Stepto", "Vanessa Watson", "Louise Fletcher", "Sam Naylor", "Rachel Turner")
    If UBound(filter(ManagerNames, Application.UserName)) < 0 Then Exit Sub
    
    For Each cell In Sheets("Access").Range("C9:C12")
        ActiveWorkbook.Worksheets(cell.Value).Visible = True
    Next cell
    
End Sub

Private Sub Workbook_BeforeSaves(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cell As Range

    For Each cell In Sheets("Access").Range("C27:C28")
        ActiveWorkbook.Worksheets(cell.Value).Visible = xlVeryHidden
    Next cell
    
End Sub

Private Sub Workbook_Opens()
Dim cell As Range, EmployeeNames As Variant

    EmployeeNames = Array("Andrew Grainger", "Cathy Jones", "Paul Stepto", "Vanessa Watson", "Louise Fletcher", "Sam Naylor", "Rachel Turner")
    If UBound(filter(EmployeeNames, Application.UserName)) < 0 Then Exit Sub
    
    For Each cell In Sheets("Access").Range("C27:C28")
        ActiveWorkbook.Worksheets(cell.Value).Visible = True
    Next cell
    
End Sub

....but, although the leave card's only being used with a limited number of employees at the moment, other managers have heard about the leave card and now want to use it with their teams. This makes it impractical to have the manager names and employee hard-coded in the VBA, so I've set it up so that the managers and employee details also now come from a range on the 'Access' page which can be updated from a central Excel workbook that all the leave cards can pull data from. It's this part that's causing the problem now. I've tried to get the range into an array and into the original code, but this is where it's come unstuck. This is the VBA I'm now trying to use:

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cell As Range

    For Each cell In Sheets("Access").Range("C9:C12").Value2
        ActiveWorkbook.Worksheets(cell.Value).Visible = xlVeryHidden
    Next cell
    
End Sub

Private Sub Workbook_Open()
Dim cell As Range
Dim ManagerNames() As Variant

    ManagerNames = Sheets("Access").Range("G9:G18").Value2
    If UBound(filter(ManagerNames, Application.UserName)) < 0 Then Exit Sub
    
    For Each cell In Sheets("Access").Range("C9:C12").Value2
        ActiveWorkbook.Worksheets(cell.Value).Visible = True
    Next cell
    
End Sub

Private Sub Workbook_BeforeSaves(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cell As Range

    For Each cell In Sheets("Access").Range("C27:C28").Value2
        ActiveWorkbook.Worksheets(cell.Value).Visible = xlVeryHidden
    Next cell
    
End Sub

Private Sub Workbook_Opens()
Dim cell As Range
Dim EmployeeNames() As Variant

    EmployeeNames = Sheets("Access").Range("G27:G37").Value2
    If UBound(filter(EmployeeNames, Application.UserName)) < 0 Then Exit Sub
    
    For Each cell In Sheets("Access").Range("C27:C28").Value2
        ActiveWorkbook.Worksheets(cell.Value).Visible = True
    Next cell
    
End Sub

The problem is that now when the file is opened I get a runtime error 13 message and it stops working when it gets to the ManagerNames array. My skills with VBA are very much limited to the odd copy and paste and rename a few things where necessary (basically I haven't a clue what I'm doing with it!). Could anyone please tell me where I've gone wrong with getting the manager list into an array, and if there's a more efficient way to set up the access to the two sets of pages without simply using the whole code twice?

Many thanks,

Bliss
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Could you post your workbook to a CLOUD site for download so it can be reviewed ?
 
Upvote 0
Hi,
bit of a guess but see if this update to your code helps

VBA Code:
Private Sub Workbook_Open()
    Dim cell As Range
    Dim wsAccess As Worksheet
    Dim ManagerNames As Variant
    Dim IsManager As Boolean
   
    Set wsAccess = ThisWorkbook.Worksheets("Access")
       
    ManagerNames = wsAccess.Range("G9:G18").Value2
    IsManager = Not IsError(Application.Match(Application.UserName, ManagerNames, 0))
   
    For Each cell In wsAccess.Range("C9:C12")
        If Len(cell.Value) > 0 Then
            ThisWorkbook.Worksheets(cell.Value).Visible = IsManager
        End If
    Next cell
   
End Sub

Worth noting that savvy users can delete the existing User Name in their Excel, and type a new entry to match a manager’s name. May want to consider using Network UserName which would provide a little more security.

Dave
 
Last edited:
Upvote 0
Hi Dave,

Thank you - that's working perfectly for the managers. I realise it's not super secure, but in this case, on a leave card, it's nothing highly confidential, it's really just to stop a user authorising their own leave by going onto the Authorisation page - in reality, a manager's going to realise pretty quickly if they haven't authorised a leave request when an employee doesn't come into work and the manager knows nothing about any leave! ;)

I can't get it to work though for the employee who only gets access to two pages (again the names of which are given in a range - this time C27:C28 - managers and the employee are able to access these two pages). What I've tried to do is repeat the code, but change the names for employee access - Workbook_OpenE() for the private sub, EmployeeNames rather than ManagerNames, IsEmployee rather than IsManager, and wsAccessE rather than wsAccess. I'm not sure if I've missed renaming something, or if I'm fundamentally approaching this the wrong way. Are you able to point me in the right direction please?

Many thanks,

Bliss
 
Upvote 0
EDIT: Addition to above post:

The two pages the employee is able to access, 'Leave' and 'Configuration' are again given in a range - this time C27:C28. The separate list of those able to access these two pages, managers + employee are in the range G27:G37.
 
Upvote 0
Hi,
Sounds like going in right direction.

Have a look here:Password Protect Viewing for Multiple Worksheets

#post 3 & see if this approach will be of any help to you
Solution creates a table of all worksheets that you place x against each users name (network name) for worksheet(s) they have access to.
Admin user(s) have full access.

Dave
 
Upvote 0
Hi Dave,

Thanks for taking the time to look at this. I've looked at the link you posted, and it looks perfect for the next project I'm going to be working on, where there'll be a limited number of people using the workbook, and authorised to access the sheets, and setting up access permissions in a table will work great for that. Bookmarked and noted.

With this project though it's more complex. There are a large number of users in a number of teams with different managers. To keep it manageable for our admin teams (and me!) it's set up with the authorised managers in a range so that when an employee sets up their leave card, on the Configuration page they select the name of their manager from a drop-down list, and also the name of their manager's manager which are added into the range of those authorised, and dependent on the department they're in governs which admin staff are added to the list. The leave card’s currently used by around 30 people in two teams, but now two departments want to use it, so it’s going to be used by 200+ people. I needed to find a way to make it possible for admin staff to update some values without having to go into each leave card, so many values are got from a central workbook holding many list options and values for some formulas. With 200+ users it would take a large amount of time to individually set up manager access for each employee.

It's the employee themselves who, unknowingly, set up the access for their leave card when they complete the configuration of their card by selecting the managers. The employee names, when they complete the cell containing the employee name, are from a drop-down list with data validation, as are the manager names. Employees can only select a manager name if it’s on the list which is set up via data validation, so they can’t put their own name in as a manager.

I’ve now got the leave card working (I’d forgotten to rename “wsAccess”) and hiding the sheets correctly for managers and the employee, except for one aspect. If there’s no employee name selected on the ‘Welcome’ sheet, so if the employee name cell is empty, or if the employee name on the ‘Welcome’ sheet doesn’t match your username, or you’re not on the manager list, the only sheet visible should be that ‘Welcome’ sheet. I know it’s not particularly secure and that a user could change the employee name to their own name to access the ‘Leave’ and ‘Configuration’ sheets, but it’s nothing highly sensitive, and I just need to stop the casual user having immediate access to the two sheets.

Is there a way to add a check whether the employee name’s blank or doesn’t match the user’s username into the VBA code?

Thanks,

Bliss
 
Upvote 0
Hi Dave,

Is there a way to add a check whether the employee name’s blank or doesn’t match the user’s username into the VBA code?

Thanks,

Bliss

You can check for valid user in the workbook open event & take steps as require

Following is just code suggestion that you will need to adjust to meet specific project need but hopefully, goes in right direction

VBA Code:
Private Sub Workbook_Open()
    Dim rngEmployee As Range, rngManagersList As Range
    Dim UsersName As String
    Dim IsValidUser As Boolean
   
    UsersName = Application.UserName

    With ThisWorkbook
'change sheet name & range as required
    Set rngEmployee = .Worksheets("Welcome").Range("A10").Value
    Set rngManagersList = .Worksheets("Managers List").Columns(1)
    End With
   
    IsValidUser = CBool(rngEmployee.Value = UsersName And _
                        Not IsError(Application.Match(UsersName, rngManagersList, 0)))
   
    If Not IsValidUser Then
   
    'do stuff
   
    Else

   'valid user

    End If
   
End Sub

Dave
 
Last edited:
Upvote 0
Thank you Dave. I've looked at the code you posted, and as you suggested, changed the sheet names and ranges. I'm very new to VBA, and while when I see VBA code I can usually figure out what it's doing, I'm fairly clueless when it comes to writing it myself. :biggrin:

I'm guessing that the above code needs to be wrapped around the code I already have (no idea if I'm right in thinking this), so I've renamed the first Private Sub Workbook_Open() in my code (the bit that sets the details for manager access) to Private Sub Workbook_OpenM().

This is the code I have now, but when I try to open the file now I get either an error saying there's an unexpected 'end sub' or a compile error.

VBA Code:
Private Sub Workbook_Open()
    Dim rngEmployee As Range, rngManagersList As Range
    Dim UsersName As String
    Dim IsValidUser As Boolean
 
    UsersName = Application.UserName

    With ThisWorkbook
'change sheet name & range as required
    Set rngEmployee = .Worksheets("Access").Range("G27:G37").Value
    Set rngManagersList = .Worksheets("Access").Range("G9:G18").Value
    End With
 
    IsValidUser = CBool(rngEmployee.Value = UsersName And _
                        Not IsError(Application.Match(UsersName, rngManagersList, 0)))
 
If Not IsValidUser Then
 
    'do stuff
 
    Else

Private Sub Workbook_OpenM()
    Dim cell As Range
    Dim wsAccess As Worksheet
    Dim ManagerNames As Variant
    Dim IsManager As Boolean
 
    Set wsAccess = ThisWorkbook.Worksheets("Access")
     
    ManagerNames = wsAccess.Range("G9:G18").Value2
    IsManager = Not IsError(Application.Match(Application.UserName, ManagerNames, 0))
 
    For Each cell In wsAccess.Range("C9:C12")
        If Len(cell.Value) > 0 Then
            ThisWorkbook.Worksheets(cell.Value).Visible = IsManager
        End If
    Next cell
 
End Sub

Private Sub Workbook_OpenE()
    Dim cell As Range
    Dim wsAccessE As Worksheet
    Dim EmployeeNames As Variant
    Dim IsEmployee As Boolean
 
    Set wsAccessE = ThisWorkbook.Worksheets("Access")
     
    EmployeeNames = wsAccessE.Range("G27:G37").Value2
    IsEmployee = Not IsError(Application.Match(Application.UserName, EmployeeNames, 0))
 
    For Each cell In wsAccessE.Range("C27:C28")
        If Len(cell.Value) > 0 Then
            ThisWorkbook.Worksheets(cell.Value).Visible = IsEmployee
        End If
    Next cell
 

    End If
 
End Sub

With my knowledge of VBA, I've no idea where to start with fixing this.

The other thing I was wondering about is how come if, with the code I was using, viewing specified pages was limited to managers (which was working), and for the employee was limited to the 'Welcome' page (which doesn't have any restrictions) and the 'Leave' and 'Configuration' pages, why do the 'Leave' and 'Configuration' pages still remain visible to anyone? Or is it that my code for the employees wasn't working properly at all? I'm thinking that logically if certain pages are limited only to managers, and that other pages are limited only to the employee and managers, it should mean that that anyone else should only be able to see the only page without any restrictions, the 'Welcome' page, so additional code shouldn't be necessary. Am I fundamentally missing something here?

Thanks,

Bliss
 
Upvote 0
Hi,
Workbook_Open is event code that cannot be renamed is placed in the Thisworkbook code page.

Looking at what you have attempted to do you have placed a Sub procedure within another procedure which as you have found out, will not work.

Would it be possible to place copy of your workbook with dummy data in a dropbox & provide a link to it here?

Dave
 
Upvote 0

Forum statistics

Threads
1,223,162
Messages
6,170,431
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top