Lock cells based on calculated value from another cell

[Dedeke]

Hello need some help to achieve this.

In column U i have values "used" or "free" wich are calculated by a formula.
I would like to lock cells based on those 2 values.
Example: if U5 = "used" the cells E5 - I5 - M5 - Q5 should be locked. If the value from U5 should change into "free" those cells should be unlocked again.
This should happen for a range U4:U35 into the corresponding rows.

Many thx already

 

[DanteAmor]

Try the following code in your sheet events.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, rng2 As Range
  Dim lckd As Variant
  
  Set rng = Range("U4:U35")
  
  ActiveSheet.Unprotect
  
  If Not Intersect(Target, rng.Precedents) Is Nothing Then
    For Each c In rng
      Set rng2 = Range("E" & c.Row & ",I" & c.Row & ",M" & c.Row & ",Q" & c.Row)
      Select Case LCase(Range("U" & c.Row).Value)
        Case LCase("used"): lckd = True
        Case LCase("free"): lckd = False
        Case Else:          lckd = ""
      End Select
      If lckd <> "" Then rng2.Locked = lckd
    Next
  End If
  
  ActiveSheet.Protect
End Sub

NOTE SHEET EVENT

Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.​

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[Dedeke]

@DanteAmor,

Thx for the verry quick response. Works like i want it to.
Is it possible to expand this for 2 more ranges??
Range V4:V34 should do the same with the columns F / J / N /R
Range W4:W34 ..... columns G / K /O /S

 

[DanteAmor]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngU As Range, rngV As Range, rngW As Range, c As Range, rng2 As Range
  Dim lckd As Variant
  
  ActiveSheet.Unprotect
  
  Set rngU = Range("U4:U35")
  If Not Intersect(Target, rngU.Precedents) Is Nothing Then
    For Each c In rngU
      Set rng2 = Range("E" & c.Row & ",I" & c.Row & ",M" & c.Row & ",Q" & c.Row)
      Select Case LCase(Range("U" & c.Row).Value)
        Case LCase("used"): lckd = True
        Case LCase("free"): lckd = False
        Case Else:          lckd = ""
      End Select
      If lckd <> "" Then rng2.Locked = lckd
    Next
  End If
  
  Set rngV = Range("V4:V35")      'Range V4:V34 ... columns F / J / N /R
  If Not Intersect(Target, rngV.Precedents) Is Nothing Then
    For Each c In rngV
      Set rng2 = Range("F" & c.Row & ",J" & c.Row & ",N" & c.Row & ",R" & c.Row)
      Select Case LCase(Range("V" & c.Row).Value)
        Case LCase("used"): lckd = True
        Case LCase("free"): lckd = False
        Case Else:          lckd = ""
      End Select
      If lckd <> "" Then rng2.Locked = lckd
    Next
  End If
  
  Set rngW = Range("W4:W35")      'Range W4:W34 ..... columns G / K /O /S
  If Not Intersect(Target, rngW.Precedents) Is Nothing Then
    For Each c In rngW
      Set rng2 = Range("G" & c.Row & ",K" & c.Row & ",O" & c.Row & ",S" & c.Row)
      Select Case LCase(Range("W" & c.Row).Value)
        Case LCase("used"): lckd = True
        Case LCase("free"): lckd = False
        Case Else:          lckd = ""
      End Select
      If lckd <> "" Then rng2.Locked = lckd
    Next
  End If
  
  ActiveSheet.Protect
End Sub

 

[Dedeke]

Thx, works just as well