locking / unlocking cell in formula

[Manuel Murieta]

E F
1 Do you own a guitar validation cell (yes/no)
2 If yes is it a Gibson
3 Is it a 5 string
4 Is it electric
5 Do you own a piano
6 Is it electric
7 Does it have 88 keys
8 Do you own a TV
9 Is it color
10 Is it an LCD
11 Is it 25"
12 Is it 32"
13 Is it 42"
14 Do you own a radio

I would like to lock cells F2:F4 if F1 contains the word "no"
I would also like to lock cells F6:F7 if F5 contains the word "no"
I would also like to lock cells F9:F13 if F8 contains the word "no"
I would like to lock cells F11:F13 if F10 is "no"

I have multiple cells like this. Are there any conditional formulas that
I can use in the cells rather than a sheet macro to do this. If not what
macros can be used.

I would also like to hide certain lines if certain cells contain certain
words.

For example if F1 is "no" then I would like to hide rows 2,3 and 4. If
F1 is changed to "yes" then the rows become visible.

Any ideas?

 

[volodind]

Try this code. Paste it to "ThisWorkbook" section of VBAProject.


Private Sub Workbook_SheetChange1(ByVal Sh As Object, ByVal Target As
Range)
Dim HideRows(4) As String
Dim MyRange(4) As String
Dim MyRow(4) As Integer
Dim MyColumn As Integer
Dim i As Integer

MyRange(1) = "F2:F4"
MyRange(2) = "F6:F7"
MyRange(3) = "F9:F13"
MyRange(4) = "F11:F13"
HideRows(1) = "2:4"
HideRows(2) = "6:7"
HideRows(3) = "9:13"
HideRows(4) = "11:13"
MyRow(1) = 1
MyRow(2) = 5
MyRow(3) = 8
MyRow(4) = 10
MyColumn = 6

For i = 1 To 4
If Target.Column = MyColumn And Target.Row = MyRow(i) Then
If LCase(Target.Formula) = "no" Then
Range(MyRange(i)).Locked = True 'decide on which to
use: locking cells
'Rows(HideRows(i)).EntireRow.Hidden =
True ' or hiding rows
ElseIf LCase(Target.Formula) = "yes" Then
Range(MyRange(i)).Locked = False
'Rows(HideRows(i)).EntireRow.Hidden = False
End If
End If
Next i
End Sub

 

[volodind]

OK. Once again: now you can copy/paste this to "ThisWorkbook":

Private Sub Workbook_SheetChange _
(ByVal Sh As Object, ByVal Target As Range)

Dim HideRows(4) As String
Dim MyRange(4) As String
Dim MyRow(4) As Integer
Dim MyColumn As Integer
Dim i As Integer

MyRange(1) = "F2:F4"
MyRange(2) = "F6:F7"
MyRange(3) = "F9:F13"
MyRange(4) = "F11:F13"
HideRows(1) = "2:4"
HideRows(2) = "6:7"
HideRows(3) = "9:13"
HideRows(4) = "11:13"
MyRow(1) = 1
MyRow(2) = 5
MyRow(3) = 8
MyRow(4) = 10
MyColumn = 6

For i = 1 To 4
If Target.Column = MyColumn And Target.Row = MyRow(i) Then
If LCase(Target.Formula) = "no" Then
Range(MyRange(i)).Locked = True
'Rows(HideRows(i)).EntireRow.Hidden = True
ElseIf LCase(Target.Formula) = "yes" Then
Range(MyRange(i)).Locked = False
'Rows(HideRows(i)).EntireRow.Hidden = False
End If
End If
Next i
End Sub

 

[Manuel Murieta]

I get an error when I put this into the "thisworkbook" It says that the
error is "unable to set the Locked Property in the Range Class" Error
1004. The line number where the error is occurring is
"Range(MyRange(i)).Locked = True"

Any idea what the problem is. I am using Excel 2003

 

[Dave Peterson]

Without looking at the whole solution, I'd try changing this:
Range(MyRange(i)).Locked = True
to:
sh.Range(MyRange(i)).Locked = True

There are a couple of spots to fix.

 

[Manuel Murieta]

I did as you said but find that the subroutine is not working. I have not
found the problem that stops the routine form working.

 

[Dave Peterson]

I made modifications to volodind's code.

And since it looks like this is for a single sheet, I wouldn't use the
workbook_sheetchange event. I'd use the worksheet_change event.

If you want to try this, rightclick on the worksheet tab that should have this
behavior. Select view code and paste this into that code window.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRowsToHide As Variant
Dim myRngToLock As Variant
Dim myCellsToWatch As Variant
Dim iCtr As Long
Dim DoStuff As Boolean
Dim myPWD As String

myPWD = "hi" '<-- change to the correct password

'one cell at a time
If Target.Cells.Count > 1 Then Exit Sub

myCellsToWatch = Array("f1", "f5", "F8", "f10")
myRngToLock = Array("f2:f4", "F6:f7", "F9:F13", "f11:f13")
myRowsToHide = Array("2:4", "6:7", "9:13", "11:13")

If UBound(myCellsToWatch) <> UBound(myRngToLock) _
Or UBound(myCellsToWatch) <> UBound(myRowsToHide) Then
MsgBox "Design Error!"
Exit Sub
End If

DoStuff = False
For iCtr = LBound(myCellsToWatch) To UBound(myCellsToWatch)
If Intersect(Target, Me.Range(myCellsToWatch(iCtr))) Is Nothing Then
'keep looking
Else
DoStuff = True
Exit For
End If
Next iCtr

'not in one of the cells to watch
If DoStuff = False Then Exit Sub

Me.Unprotect Password:=myPWD
Me.Range(myRngToLock(iCtr)).Locked = CBool(LCase(Target.Value) = "no")
Me.Range(myRowsToHide(iCtr)).EntireRow.Hidden _
= CBool(LCase(Target.Value) = "no")
Me.Protect Password:=myPWD

End Sub

Remember to remove that previous code.

 

[Manuel Murieta]

The code worked well. I have one wrinkle that I need to pursue. I also have
several areas where I need to do the same but where the word "yes" would
trip the changes. In other words answering "yes" in E1 would lock and hide
E2:E4 and answereing "yes" in E6 would lock and hide E7:e10

Could this be incorporated in one subroutine. I tried copying the entire
subroutine and giving it a different name "Private Sub
Worksheet_Change_New(ByVal Target As Range)", but this didn't work.

 

[Dave Peterson]

You can't just add new events, so that won't work.

But you add more rules to your code. Since the main idea is pretty much the
same, I figured that just adding more addresses to each of the address variables
would work ok.

But since you're changing the rules (sometimes "no", sometimes "yes"), you'll
have to keep track of that too:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRowsToHide As Variant
Dim myRngToLock As Variant
Dim myCellsToWatch As Variant
Dim WhatToLookFor As Variant
Dim iCtr As Long
Dim DoStuff As Boolean
Dim myPWD As String

myPWD = "hi" '<-- change to the correct password

'one cell at a time
If Target.Cells.Count > 1 Then Exit Sub

myCellsToWatch = Array("f1", "f5", "F8", "f10", "E1", "e6")
myRngToLock = Array("f2:f4", "F6:f7", "F9:F13", _
"f11:f13", "E2:E4", "E7:e10")
myRowsToHide = Array("2:4", "6:7", "9:13", "11:13", "2:4", "7:10")
WhatToLookFor = Array("no", "no", "no", "no", "yes", "yes")

If UBound(myCellsToWatch) <> UBound(myRngToLock) _
Or UBound(myCellsToWatch) <> UBound(myRowsToHide) _
Or UBound(myCellsToWatch) <> UBound(WhatToLookFor) Then
MsgBox "Design Error!"
Exit Sub
End If

DoStuff = False
For iCtr = LBound(myCellsToWatch) To UBound(myCellsToWatch)
If Intersect(Target, Me.Range(myCellsToWatch(iCtr))) Is Nothing Then
'keep looking
Else
DoStuff = True
Exit For
End If
Next iCtr

'not in one of the cells to watch
If DoStuff = False Then Exit Sub

Me.Unprotect Password:=myPWD

Me.Range(myRngToLock(iCtr)).Locked _
= CBool(LCase(Target.Value) = LCase(WhatToLookFor(iCtr)))

Me.Range(myRowsToHide(iCtr)).EntireRow.Hidden _
= CBool(LCase(Target.Value) = LCase(WhatToLookFor(iCtr)))

Me.Protect Password:=myPWD

End Sub

The code worked well. I have one wrinkle that I need to pursue. I also have
several areas where I need to do the same but where the word "yes" would
trip the changes. In other words answering "yes" in E1 would lock and hide
E2:E4 and answereing "yes" in E6 would lock and hide E7:e10

Could this be incorporated in one subroutine. I tried copying the entire
subroutine and giving it a different name "Private Sub
Worksheet_Change_New(ByVal Target As Range)", but this didn't work.

 

[Manuel Murieta]

The code works well. Howevere here is another wrinkle. I have several fields
where the word "yes" should lock cells and hide lines. If one enters "yes"
in E1, then E2:E5 would be locked and line 2-5 would be hidden. if E6
contained "yes" then E7:E9 would be locked and rows 7-9 would be hidden. I
tried copying the other subroutine and renaming it and changing it to
conform to the new criteria, but that did not work. Is there anyway to
incorporate this into the one subroutine to take care of all instances?

 

[Dave Peterson]

You didn't see the other reply?????

The code works well. Howevere here is another wrinkle. I have several fields
where the word "yes" should lock cells and hide lines. If one enters "yes"
in E1, then E2:E5 would be locked and line 2-5 would be hidden. if E6
contained "yes" then E7:E9 would be locked and rows 7-9 would be hidden. I
tried copying the other subroutine and renaming it and changing it to
conform to the new criteria, but that did not work. Is there anyway to
incorporate this into the one subroutine to take care of all instances?