Solved

Protect Ranges

Posted on 2012-03-27
2
253 Views
Last Modified: 2012-03-27
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
0
Comment
Question by:Seamus2626
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
ID: 37770633
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
 

Author Closing Comment

by:Seamus2626
ID: 37770685
As usual, hero stuff.

Thanks Rory

Seamus
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question