I am setting up a spreadsheet to trend data for analytical testing of chemical products. I would like for each line of data to be locked once the transcription of said data has been verified by the reviewer. I am able to lock a single line using this code in VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("X3") = "No" Then
Range("B3:W3").Locked = False
ElseIf Range("X3") = "Yes" Then
Range("B3:W3").Locked = True
End If
End Sub
Column X contains a dropdown list with "Yes" and "No" as the two options. I would like for each line of data, as it is added to the sheet, to be locked once the reviewer has selected yes in this column to make sure no unintended changes are made to past data. Is this possible without having to repeat the about code for each line indefinitely?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("X3") = "No" Then
Range("B3:W3").Locked = False
ElseIf Range("X3") = "Yes" Then
Range("B3:W3").Locked = True
End If
End Sub
Column X contains a dropdown list with "Yes" and "No" as the two options. I would like for each line of data, as it is added to the sheet, to be locked once the reviewer has selected yes in this column to make sure no unintended changes are made to past data. Is this possible without having to repeat the about code for each line indefinitely?
Accepted Answer
Hi StephanieS,
Please try the code below, if you have any further questions, please don't hesitate to ask me.
Amanda
Please try the code below, if you have any further questions, please don't hesitate to ask me.
Amanda
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPassword As String
Dim xRgAddress As String
Dim xLockRgAddress As String
Dim Row As Integer
xPassword = "123456" 'Please replace 123456 with the password that protects the spreadsheet.
On Error Resume Next
If (Target.Column <> 24) Then
Exit Sub
End If
Row = Target.Row
If Target = "Yes" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ElseIf Target = "No" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub I also need it to be able to change the status of these cells from unlocked to locked while the spreadsheet is protected, otherwise this feature is useless.
Accepted Answer
Hi StephanieS,
Please try the code below, if you have any further questions, please don't hesitate to ask me.
Amanda
Please try the code below, if you have any further questions, please don't hesitate to ask me.
Amanda
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPassword As String
Dim xRgAddress As String
Dim xLockRgAddress As String
Dim Row As Integer
xPassword = "123456" 'Please replace 123456 with the password that protects the spreadsheet.
On Error Resume Next
If (Target.Column <> 24) Then
Exit Sub
End If
Row = Target.Row
If Target = "Yes" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ElseIf Target = "No" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub Thank you so much! That code worked perfectly. I am still very new to VBA so I really appreciate your help! 
- Page :
- 1
There are no replies made for this post yet.