user lists part 2

MarkRush

New Member
Joined
Mar 6, 2018
Messages
22
so a while back a very knowledgeable user DMT32 helped me update his macro to meet my needs and all of a sudden it started having issues. Works great for users defined as admin but everyone else gets a Subscript out of range error. The Macro does do what its supposed to do, but the error is a nuisance hope someone can help

The original post was here

https://www.mrexcel.com/forum/excel-questions/1047798-vba-hide-worksheets-based-windows-user-names.html

my code is here

Code:
Private Sub Workbook_Open()
    Dim Admin As Boolean
    Dim msg As Variant
    Dim LastCol As Integer, C As Integer
    Dim rng As Range
    Dim sh As Worksheet, Userlist As Worksheet


    


    On Error GoTo myerror
     
        ThisWorkbook.Sheets(HomeSheet).Visible = xlSheetVisible
       
        HideSheets


        Set Userlist = UserTable("User List")
       
        With Userlist
            .Unprotect Password:=shPassword
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set rng = .Range("A2:A" & lastrow)
        End With




    'check valid user
    If IsValidUser(rng, Admin) Then
            Application.ScreenUpdating = False
            'Admin User unhide all sheets
            If Admin Then
                For Each sh In ThisWorkbook.Worksheets
                    sh.Visible = xlSheetVisible
                    sh.Unprotect Password:=shPassword
                Next sh
            Else
                'unhide user sheets
                With Userlist
                    For C = 3 To LastCol
                        If UCase(.Cells(rng.Row, C).Value) = "X" Then
                            With Sheets(.Cells(1, C).Value)
                                .Visible = xlSheetVisible
                                '.Unprotect Password:=shPassword
                            End With
                        End If
                    Next C
                   'If Len(shPassword) > 0 Then .Protect Password:=shPassword
                End With
            End If
            'activate home sheet
            Worksheets(HomeSheet).Activate
            
        Else
           'user Not Valid
    
            For C = 3 To LastCol
                If UCase(Userlist.Cells(2, C).Value) = "X" Then
                    With Sheets(Userlist.Cells(1, C).Value)
                        .Visible = xlSheetVisible
                        .Unprotect Password:=shPassword
                    End With
                End If
            Next C
'activate home sheet
            Worksheets(HomeSheet).Activate
            If Len(shPassword) > 0 Then Userlist.Protect Password:=shPassword


        End If
        
myerror:
Application.ScreenUpdating = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"


Sheets("sf1").Visible = Hidden
[Min_Margin].Value = 0.3
Set ws = Sheets("Detailed Proposal")
With Sheets("Detailed Proposal")
.Protect Password:="password", AllowFormattingCells:="true", AllowFormattingColumns:="true", AllowFormattingRows:="true"
End With


Set ws = Sheets("configuration")
With Sheets("configuration")
.Protect Password:="password", AllowFormattingCells:="true", AllowFormattingColumns:="true", AllowFormattingRows:="true"
End With


Set ws = Sheets("Implementation Questionaire")
With Sheets("Implementation Questionaire")
.Protect Password:="password", AllowFormattingCells:="true", AllowFormattingColumns:="true", AllowFormattingRows:="true"
End With




End Sub
any help would be appreciated
 
Last edited:

Forum statistics

Threads
1,081,676
Messages
5,360,441
Members
400,586
Latest member
Minty

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top