SOLVED

VBA Code Working

Copper Contributor

Hi guys,

 

I got this code from YouTube Video and it keeps giving me an error (Run-time error '9': Subscript out of range) on line 66.  I have:

  • double checked the code - it seems fine
  • I have included all sheets on my User Management sheet (see attachment)
  • rewritten the code - it seems fine

 

Can anyone please advise here?

 

 

 

Private Sub Login_LoginBtn_Click()

Dim sh As Worksheet
'Dim welcomesh As Worksheet

'Set welcomesh = ThisWorkbook.Sheets("Welcome")
Set sh = ThisWorkbook.Sheets("User Management")

If Me.txt_UserName.Value = "" Then
    MsgBox "Please enter your User Name", vbCritical                                            '''' Check for User Name
    Exit Sub
End If

If Me.txt_Password.Value = "" Then
    MsgBox "Please enter your Password", vbCritical                                             '''' Check for Password
    Exit Sub
End If

If Application.WorksheetFunction.CountIf(sh.Range("A:A"), Me.txt_UserName.Value) = 0 Then
    MsgBox "Invalid User Name", vbCritical                                                      '''' Check if User Name exisit in our DB
    Exit Sub
End If

Dim user_row As Integer

user_row = Application.WorksheetFunction.Match(Me.txt_UserName.Value, sh.Range("A:A"), 0)

If Me.txt_Password.Value <> sh.Range("C" & user_row).Value Then
    MsgBox "Invalid Password", vbCritical                                                       '''' Check if Password exisit in our DB and correct
    Exit Sub
End If

Dim lock_Worksheet, Unlock_Worksheet As Integer

lock_Worksheet = Application.WorksheetFunction.CountIf(sh.Range("E" & user_row, "XFD" & user_row), "Ï")
Unlock_Worksheet = Application.WorksheetFunction.CountIf(sh.Range("E" & user_row, "XFD" & user_row), "Ð")

If (lock_Worksheet + Unlock_Worksheet) = 0 Then
    MsgBox "You do not have access, please contact your admin"                                  '''' Check if they have access
End If

'''' Apply setting to user role

Dim wsh As Worksheet
Dim i As Integer

If sh.Range("B" & user_row).Value = "Admin" Then        ''''This is to give access to Admin
    sh.Unprotect BEX
    sh.Cells.EntireColumn.Hidden = False
    sh.Cells.EntireRow.Hidden = False
    
    ThisWorkbook.Unprotect BEX
    For Each wsh In ThisWorkbook.Worksheets
        wsh.Visible = xlSheetVisible
        wsh.Unprotect BEX
    Next wsh
    
    ActiveWindow.DisplayWorkbookTabs = True

Else            '''' This is to give access to User

ThisWorkbook.Unprotect BEX
ActiveWindow.DisplayWorkbookTabs = True

    For i = 5 To Application.WorksheetFunction.CountA(sh.Range("2:2"))
        Set wsh = ThisWorkbook.Sheets(sh.Cells(2, i).Value)
       
        If sh.Cells(user_row, i).Value = "Ð" Then    ''' for unlock
            wsh.Visible = xlSheetVisible
            wsh.Unprotect BEX
        ElseIf sh.Cells(user_row, i).Value = "Ï" Then    ''' for unlock
            wsh.Visible = xlSheetVisible
            wsh.Protect BEX
        End If
     
    Next i

End If

End Sub

 

 

 

2 Replies
best response confirmed by ClaudeV2240 (Copper Contributor)
Solution

@ClaudeV2240 

Does the error appear for i = 13?

Line 66 of the code refers to a worksheet named according to the value in ThisWorkbook.Sheets(sh.cells(2, i).value) which would be ThisWorkbook.Sheets("ATHLONE EXPRESS BLACK") for i = 13.

According to your screenshot there isn't a worksheet named "ATHLONE EXPRESS BLACK" which would explain the error message.

 

Hi, I actually solved it. I have the other sheet names in my User Management Sheet already without creating the sheets. When I removed them I solved the problem. But thanks. Tried yours and it worked also.
1 best response

Accepted Solutions
best response confirmed by ClaudeV2240 (Copper Contributor)
Solution

@ClaudeV2240 

Does the error appear for i = 13?

Line 66 of the code refers to a worksheet named according to the value in ThisWorkbook.Sheets(sh.cells(2, i).value) which would be ThisWorkbook.Sheets("ATHLONE EXPRESS BLACK") for i = 13.

According to your screenshot there isn't a worksheet named "ATHLONE EXPRESS BLACK" which would explain the error message.

 

View solution in original post