CODEWITHSUNDEEP
vbaexcel
jallington
jallington

Reputation: 181

Multiple passwords each with a unique result

I want multiple correct passwords and for each password to do something different.

Sub zebra()

Dim MyPassword As String
MyPassword = "Zebra" ' Change this to alter password
If InputBox("Please enter password to continue.", "Enter Password") <> MyPassword Then

    Dim Ans As Boolean
    Const Pword As String = "Zebra" ' This should match password
    
    Ans = False
    
    Do While Ans = False
        If InputBox("Please enter password to continue.", "Enter Password") = Pword Then
            Ans = True
        End If
    Loop
    Exit Sub
End If

Sheets("Level 3").Visible = True ' This selects what sheet should become visible

End Sub

Essentially, pop-up window, enter Zebra password, loop if wrong, unlock sheet "level 3 if correct". I would like the password Zebra to unlock Level 3 but another password such as "Tiger" unlock another sheet such as "Level 2".

In the end, what ever the password is, I need a specific and unique result.

I would like to avoid writing multiple codes because the user interface needs to be simple enough for any level of proficiency to click a button, enter a password, and receive the correct information with all other information being hidden as it is highly confidential.

Code example

Upvotes: 0

Views: 2593

Answers (3)

Sorceri
Sorceri

Reputation: 8053

Here is another example 

Option Base 1
Sub CheckPassword()
Dim allPasswords(3)
allPasswords(1) = "Zebra"
allPasswords(2) = "Tiger"
allPasswords(3) = "Monkey"

Dim passwordEntered As String
Dim iChanceCount As Integer
Dim ws As Worksheet


Do While True
    passwordEntered = InputBox("Please enter password to continue.", "Enter Password")
    If passwordEntered = allPasswords(1) Then
        Set ws = Sheets("Level 1")
    Else
        If passwordEntered = allPasswords(2) Then
            Set ws = Sheets("Level 2")
        Else
            If passwordEntered = allPasswords(3) Then
                Set ws = Sheets("Level 3")
            End If
        End If
    End If
    'see if we set the worksheet
    If ws Is Nothing Then
        iChanceCount = iChanceCount + 1
        'give them 5 tries then exit
        If iChanceCount >= 5 Then Exit Sub
    Else
        'we have a worksheet so make it visible and exit
        ws.Visible = xlSheetVisible
        Exit Sub
    End If


Loop


End Sub

Upvotes: 2

user8753746
user8753746

Reputation:

First off all, the way you are trying to apply "security" is not the appropriate, so I suggest to find another alternatives to secure your file.

An alternative to what you are trying to do is to use Case Statement. An example:

Select Case MyPassword
   Case "Zebra"
      Sheets("Level 3").Visible = True
   Case "Tiger"
      Sheets("Level 3").Visible = False
      Sheets("Level 2").Visible = True
   Case "Elephant"
      AnotherAction
   Case ""
      Msgbox "Password can not be empty."
   Case Else
      Msgbox "Wrong password."
End Select

Hope it helps.

Upvotes: 4

Fernando J. Rivera
Fernando J. Rivera

Reputation: 749

This should work, however, you should definitely not use this for sensitive data. If you want to restrict access to diferent sheets for each user, I recommend simply having a separate workbook for each user and having yourself a master file that collects data from all of these workbooks.

Sub testy2ElectricBoogaloo()
    dim i as long, ans as boolean
    Dim mystr As String
    ans = False
    ReDim arr(1 To Worksheets.Count, 1 To 2)
    For i = 1 To UBound(arr)
     arr(i, 1) = Worksheets(i).Name
    'My code makes every password simply the sheet name followed by a smiley face.
    'Adjust to fit your actual passwords.
     arr(i, 2) = Worksheets(i).Name & " :)" 
    Next i
    Do While ans = False
        mystr = InputBox("Please enter password to continue.", "Enter Password")
        If mystr = vbNullString Then Exit Sub
        For i = 1 To ThisWorkbook.Worksheets.Count
        If mystr = arr(i, 2) Then ans = True: Worksheets(arr(i, 1)).Visible = True: Exit For
        Next i
    Loop
End Sub

Upvotes: 0

Related Questions