Protect Ranges

Hi,

I have the below code to protect ranges. I want the password to be able to take two answers, so SPW1 = "CP" or "Generic" etc

Can anyone amend to allow this?

Thanks
Seamus








Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sPW1 As String, sPW2 As String, sPW3 As String, sPW4 As String, sPW5 As String, sPW6 As String, sPW7 As String, sPW8 As String, sPW9 As String
sPW1 = "CP"
sPW1 = "CP"
sPW2 = "CR"
sPW3 = "EW"
sPW4 = "EW"
sPW5 = "MJ"
sPW6 = "SC"
sPW7 = "SH"
sPW8 = "SW"
sPW9 = "ALL"

If Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r1" Then
        If Not PWordIsCorrect(sPW1) Then Range("A1").Select Else Range("I2") = "r1"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r2" Then
        If Not PWordIsCorrect(sPW2) Then Range("A1").Select Else Range("I2") = "r2"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r3" Then
        If Not PWordIsCorrect(sPW3) Then Range("A1").Select Else Range("I2") = "r3"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r4" Then
        If Not PWordIsCorrect(sPW4) Then Range("A1").Select Else Range("I2") = "r4"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r5" Then
        If Not PWordIsCorrect(sPW5) Then Range("A1").Select Else Range("I2") = "r5"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r6" Then
        If Not PWordIsCorrect(sPW6) Then Range("A1").Select Else Range("I2") = "r6"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r7" Then
        If Not PWordIsCorrect(sPW7) Then Range("A1").Select Else Range("I2") = "r7"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r8" Then
        If Not PWordIsCorrect(sPW8) Then Range("A1").Select Else Range("I2") = "r8"
    End If
ElseIf Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
    If Range("I2") <> "r9" Then
        If Not PWordIsCorrect(sPW9) Then Range("A1").Select Else Range("I2") = "r9"
    End If
   
Else
    Range("I2") = "Nothing"
End If
End Sub

Function PWordIsCorrect(sPass As String) As Boolean
Dim s As String
s = InputBox("Enter the password", "Password required")
If s = sPass Then PWordIsCorrect = True
If s <> sPass Then MsgBox "Wrong Password"


End Function
Seamus2626Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rory ArchibaldCommented:
Not sure I follow your logic, but try:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sPW(1 To 9) As String
    ' use the | character as a delimiter between valid passwords
    sPW(1) = "CP|General"
    sPW(2) = "CR|Blah"
    sPW(3) = "EW"
    sPW(4) = "EW"
    sPW(5) = "MJ"
    sPW(6) = "SC"
    sPW(7) = "SH"
    sPW(8) = "SW"
    sPW(9) = "ALL"
    
    If Not Application.Intersect(Range("xyz"), Target) Is Nothing Then
        If Range("I2").Value <> "r1" Then
            If Not PWordIsCorrect(sPW(1)) Then Range("A1").Select Else Range("I2").Value = "r1"
    
        ElseIf Range("I2") <> "r2" Then
                If Not PWordIsCorrect(sPW(2)) Then Range("A1").Select Else Range("I2") = "r2"
            
        ElseIf Range("I2") <> "r3" Then
                If Not PWordIsCorrect(sPW(3)) Then Range("A1").Select Else Range("I2") = "r3"
        ElseIf Range("I2") <> "r4" Then
                If Not PWordIsCorrect(sPW(4)) Then Range("A1").Select Else Range("I2") = "r4"
        ElseIf Range("I2") <> "r5" Then
                If Not PWordIsCorrect(sPW(5)) Then Range("A1").Select Else Range("I2") = "r5"
        ElseIf Range("I2") <> "r6" Then
                If Not PWordIsCorrect(sPW(6)) Then Range("A1").Select Else Range("I2") = "r6"
        ElseIf Range("I2") <> "r7" Then
                If Not PWordIsCorrect(sPW(7)) Then Range("A1").Select Else Range("I2") = "r7"
        ElseIf Range("I2") <> "r8" Then
                If Not PWordIsCorrect(sPW(8)) Then Range("A1").Select Else Range("I2") = "r8"
        ElseIf Range("I2") <> "r9" Then
                If Not PWordIsCorrect(sPW(9)) Then Range("A1").Select Else Range("I2") = "r9"
           
        Else
            Range("I2") = "Nothing"
        End If
    End If
End Sub

Function PWordIsCorrect(sPass As String, Optional sDelimiter As String = "|") As Boolean
    Dim s As String
    Dim n As Long
    Dim vPass
    PWordIsCorrect = False
    s = InputBox("Enter the password", "Password required")
    vPass = Split(sPass, sDelimiter)
    For n = LBound(vPass) To UBound(vPass)
        If s = vPass(n) Then
            PWordIsCorrect = True
            Exit Function
        End If
    Next n
    MsgBox "Wrong Password"


End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Seamus2626Author Commented:
As usual, hero stuff.

Thanks Rory

Seamus
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.