What I require:
Current State in the image attached: Cells A2:E7 are unlocked, all other cells in the sheet remain locked The remainder of the sheet is protected without a password/select unlocked cells only (but could contain a password if required)
Code below has to be entered in a Worksheet object, under VBA project properties. I have tested the code and it seems to be working. Please report if any problem comes up. If you want to extend the range on which the code works, simply edit currSheet.Range("A2") to currSheet.Range("A100") etc.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim currSheet As Worksheet
Set currSheet = ThisWorkbook.ActiveSheet
'declare source range - can be a cell, a range of cells, entire column, entirerow etc.
Dim sourceCell As Range
Set sourceCell = currSheet.Range("A2")
'declare range that will be locked/unlocked
Dim tarRange As Range
Set tarRange = currSheet.Range("B2:E2")
Application.ScreenUpdating = False
currSheet.Unprotect
If Target = sourceCell Then
set_cellLockStatus sourceCell, "Yes", tarRange, True
End If
Application.ScreenUpdating = True
currSheet.Protect
End Sub
Public Sub set_cellLockStatus(source_rng As Range, sourceValueCondition As Variant, target_rng As Range, lockCell As Boolean)
'take source range, check if source condition is met - if yes, lock or unlock target range
source_rng.Locked = False
With source_rng
If source_rng.Value2 = sourceValueCondition Then
target_rng.Locked = lockCell
target_rng.Interior.ColorIndex = 8
Else:
target_rng.Locked = Not lockCell
target_rng.Interior.ColorIndex = 0
End If
End With
End Sub
Another solution. Code in Worksheet - Change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then ' column A changed
ThisRow = Target.Row 'get row number
If Target.Value = "Yes" Then
ThisWorkbook.ActiveSheet.Unprotect 'unprotect sheet
Range("B" & ThisRow).Locked = True
Range("C" & ThisRow).Locked = True
Range("D" & ThisRow).Locked = True
Range("E" & ThisRow).Locked = True
ThisWorkbook.ActiveSheet.Protect 'protect sheeet
Else
ThisWorkbook.ActiveSheet.Unprotect
Range("B" & ThisRow).Locked = False
Range("C" & ThisRow).Locked = False
Range("D" & ThisRow).Locked = False
Range("E" & ThisRow).Locked = False
ThisWorkbook.ActiveSheet.Protect
End If
End If
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.