Im trying to write something that will lock a cells data validation list if another one contains a certain value.
I tried the following code expecting that when a cell in P had "ERROR" the cell in Q on the same row would be locked however I was still able to change the item from the data validation list.
Sub ABCD()
Application.ScreenUpdating = False
Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("1234")
Dim setting_sh As Worksheet
Set setting_sh = ThisWorkbook.Sheets("5678")
Dim nwb As Workbook
Dim nsh As Worksheet
'get unique NAME
setting_sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("C:C").Copy setting_sh.Range("A1")
setting_sh.Range("A:A").RemoveDuplicates 1, xlYes
Dim i As Integer
For i = 2 To Application.CountA(setting_sh.Range("A:A"))
data_sh.UsedRange.AutoFilter 3, setting_sh.Range("A" & i).Value
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.Columns("A:U").AutoFit
If Range("P" & i) = "ERROR" Then
Range("Q" & i).Locked = True
End If
nwb.SaveAs ****
nwb.Close False
data_sh.AutoFilterMode = False
Next i
setting_sh.Range("A:A").Clear
End Sub
I haven't tested if your whole code works as I'm not sure what kind of data you're using... but this does compile.
What you MUST do is make sure to start with all cell unlocked, then the locking section of the script can actually lock them:
Sub ABCD()
Application.ScreenUpdating = False
Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("1234")
Dim setting_sh As Worksheet
Set setting_sh = ThisWorkbook.Sheets("5678")
Dim nwb As Workbook
Dim nsh As Worksheet
'get unique NAME
setting_sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("C:C").Copy setting_sh.Range("A1")
setting_sh.Range("A:A").RemoveDuplicates 1, xlYes
Dim i As Integer
For i = 2 To Application.CountA(setting_sh.Range("A:A"))
data_sh.UsedRange.AutoFilter 3, setting_sh.Range("A" & i).Value
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.Columns("A:U").AutoFit
If Range("P" & i) = "ERROR" Then
' I'm assuming you're working with data_sh here... but idk
' I would consider making it absolute.
data_sh.Unprotect "This is a password"
data_sh.Range("Q" & i).Locked = True
data_sh.Protect "This is a password"
End If
nwb.SaveAs "C:\Users\cameron\Documents"
nwb.Close False
data_sh.AutoFilterMode = False
Next i
setting_sh.Range("A:A").Clear
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.