Note: The other languages of the website are Google-translated. Back to English
  Friday, 18 March 2022
  3 Replies
  4.7K Visits
0
Votes
Undo
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?
8 months ago
·
#2529
Accepted Answer
1
Votes
Undo
Hi StephanieS,

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
8 months ago
·
#2531
0
Votes
Undo
Thank you so much! That code worked perfectly. I am still very new to VBA so I really appreciate your help! :)
8 months ago
·
#2529
Accepted Answer
1
Votes
Undo
Hi StephanieS,

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
8 months ago
·
#2522
0
Votes
Undo
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.
  • Page :
  • 1
There are no replies made for this post yet.

Follow Us

Copyright © 2009 - www.extendoffice.com. | All rights reserved. Powered by ExtendOffice. | Sitemap
Microsoft and the Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries.
Protected by Sectigo SSL