Password Protect Viewing of Individual Worksheets?

Private Sub Workbook_Open()
Dim sht As Worksheet

For Each sht In ThisWorkbook.Sheets
    If sht.Name <> "Summary" Then
sht.Visible = xlSheetVeryHidden
End If
Next
Sheets(Environ("UserName")).Visible = True
End Sub

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
For Each ws In Sheets
If ws.Name <> "Summary" Then ws.Visible = xlSheetVeryHidden
Next ws
End Sub
 
Private Sub Workbook_Open()
Dim user As String
Dim pwd As String
Dim ct As Integer
LR = Sheets("LogIn").Cells(Rows.Count, "A").End(xlUp).Row
user = InputBox("Enter your UserName")
Set C = Worksheets("LogIn").Range("$A1:$A" & LR).Find(user, LookIn:=xlValues)
    If C Is Nothing Then
        MsgBox "Unauthorized to proceed"
        Me.Close
    End If
ct = 2
retry:
    pwd = InputBox("Enter Password")
    If pwd <> Sheets("LogIn").Cells(C.Row, 2) Then
    If ct = 0 Then
       MsgBox "Out of tries"
       Me.Close
   End If
       MsgBox "Wrong Password." & Chr(10) & "You have " & ct & " tries left"
       ct = ct - 1
       GoTo retry
   End If
Dim ws As Worksheet
For Each ws In Sheets
If ws.Name = Sheets("LogIn").Cells(C.Row, "C") Then ws.Visible = xlSheetVisible
Next ws
End Sub