Seamus2626
asked on
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(Rang e("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(Rang e("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(Rang e("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(Rang e("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(Rang e("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(Rang e("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(Rang e("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(Rang e("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(Rang e("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
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(
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(Rang
If Range("I2") <> "r1" Then
If Not PWordIsCorrect(sPW1) Then Range("A1").Select Else Range("I2") = "r1"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r2" Then
If Not PWordIsCorrect(sPW2) Then Range("A1").Select Else Range("I2") = "r2"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r3" Then
If Not PWordIsCorrect(sPW3) Then Range("A1").Select Else Range("I2") = "r3"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r4" Then
If Not PWordIsCorrect(sPW4) Then Range("A1").Select Else Range("I2") = "r4"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r5" Then
If Not PWordIsCorrect(sPW5) Then Range("A1").Select Else Range("I2") = "r5"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r6" Then
If Not PWordIsCorrect(sPW6) Then Range("A1").Select Else Range("I2") = "r6"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r7" Then
If Not PWordIsCorrect(sPW7) Then Range("A1").Select Else Range("I2") = "r7"
End If
ElseIf Not Application.Intersect(Rang
If Range("I2") <> "r8" Then
If Not PWordIsCorrect(sPW8) Then Range("A1").Select Else Range("I2") = "r8"
End If
ElseIf Not Application.Intersect(Rang
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Rory
Seamus