Adapting VBA code with runtime error 13 on array

[BlissC]

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:

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).

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:

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

 

[BlissC]

Hi Dave,

Thanks again for your help. I did wonder last night, somewhat late in the day so to speak, whether renaming Workbook_Open was a mistake, and this morning decided to do just a little fiddling to see if I could get it to work with the original code. I renamed both Workbook_Open event codes back to Workbook_Open and also, after reading your last post, removed the End Sub at the end of the manager access code. It hadn't occurred to me that I was trying to put a procedure inside another.

To my surprise, having made those changes, it suddenly worked with my original code. This is what worked in the end. As I'd envisaged, anyone not on the managers or employees list only sees the Welcome page, the employee sees the Welcome, Leave and Configuration pages, and managers see all of the pages.

'code for manager and authorised people access
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
  
'code for employee access
  
    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 Sub

Thanks again,

Bliss

 

[dmt32]

To my surprise, having made those changes, it suddenly worked with my original code.


Thanks again,

Bliss

Always satisfying when you can resolve an issue yourself.

Glad all sorted but do post back if have any further issues

Dave