"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.

This this code. Paste it into the worksheet code pane for the worksheet containing the cells you want to protect. Modify the code to match the range names in your worksheet. I used names rngTemp1, rngTemp2, rngTemp3.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim PWord As StringPWord = "MyPassword"If Not Application.Intersect(Range("rngTemp1"), Target) Is Nothing Then If Not PWordIsCorrect(PWord) Then Range("A1").SelectElseIf Not Application.Intersect(Range("rngTemp2"), Target) Is Nothing Then If Not PWordIsCorrect(PWord) Then Range("A1").SelectElseIf Not Application.Intersect(Range("rngTemp3"), Target) Is Nothing Then If Not PWordIsCorrect(PWord) Then Range("A1").SelectEnd IfEnd SubFunction PWordIsCorrect(sPass As String) As BooleanDim s As Strings = InputBox("Enter the password", "Password required")If s = sPass Then PWordIsCorrect = True Else PWordIsCorrect = FalseEnd Function

You'll ideally want to protect the VBProject and the workbook itself with a password too, otherwise nothing's stopping the users from hitting ALT+F11 and looking at the code to find the right password.

Here's an updated version. I made the assumption that as soon as someone entered the correct password they should be allowed to keep working in the range until they clicked outside the boundaries. At that point they will need to enter the password again to re-enter the range. You will need to specify a cell into which the code can dump a variable. In the example I used "I2". Modify as necessary.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim PWord As StringPWord = "MyPassword"If Not Application.Intersect(Range("rngTemp1"), Target) Is Nothing Then If Range("I2") <> "r1" Then If Not PWordIsCorrect(PWord) Then Range("A1").Select Else Range("I2") = "r1" End IfElseIf Not Application.Intersect(Range("rngTemp2"), Target) Is Nothing Then If Range("I2") <> "r2" Then If Not PWordIsCorrect(PWord) Then Range("A1").Select Else Range("I2") = "r2" End IfElseIf Not Application.Intersect(Range("rngTemp3"), Target) Is Nothing Then If Range("I2") <> "r3" Then If Not PWordIsCorrect(PWord) Then Range("A1").Select Else Range("I2") = "r3" End IfElse Range("I2") = "Nothing"End IfEnd SubFunction PWordIsCorrect(sPass As String) As BooleanDim s As Strings = InputBox("Enter the password", "Password required")If s = sPass Then PWordIsCorrect = True Else PWordIsCorrect = FalseEnd Function