简体   繁体   中英

Lock Certain Cells Based On Another Cells Value

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM