VBA Lock rows upon checkbox click on multi-sheets

[kennethshuen]

Hi guys,

I would like to make a code in VBA that locks the entirerow whenever the checkbox is checked on both sheet 1 (starting from row 3), sheet 2 (starting from row 4). What I did now was using the code below on sheet 2, and using formular [=IF('sheet 2 defined cell value <>"", "1","")] on sheet 1 to try to prompt the same code with another private sub. But apparently that doesn't work as planned and the code below isn't perfect as well. Please comment below for any ideas!!! Thank you guys!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Long


    If Not Intersect(Target, Columns("P")) Is Nothing Then
        ' the changed cell is in column P
        If Target.Cells.Count = 1 Then
            ' only act if it is a single cell, so multicell copy will not trigger this
            If Target.Value <> "" Then
                Me.Unprotect Password:="123"
                Target.EntireRow.Locked = True
                Me.Protect Password:="123"
            Else
                Me.Unprotect Password:="123"
            End If
        End If
    End If
End Sub

[大灰狼1976]

Hi kennethshuen!
Welcome to vbax forum.
It shouldn't be difficult. Could you send an attachment?
BTW, can you speak Chinese, My English is terrible.

[kennethshuen]

Hi kennethshuen!
Welcome to vbax forum.
It shouldn't be difficult. Could you send an attachment?
BTW, can you speak Chinese, My English is terrible.

Hello, thanks so much. Yea, I can read Chinese, you can type it in Chinese and if you don't mind it may be more convenient for me to reply in English.

I have attached the trial file, please have a look.

[大灰狼1976]

Like this?

Sub CheckBox_Date_Stamp()
Dim xChk As CheckBox
Set xChk = ActiveSheet.CheckBoxes(Application.Caller)
ActiveSheet.Unprotect Password:="123"
    With xChk.TopLeftCell.Offset(, 1)
        If xChk.Value = xlOff Then
            .Value = ""
        Else
            .Value = Date
        End If
    End With
ActiveSheet.Protect Password:="123"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Long
    If Not Intersect(Target, Columns("B")) Is Nothing Then
        If Target.Cells.Count = 1 Then
            If Target.Value <> "" Then
                Target.EntireRow.Locked = True
            Else
                Target.EntireRow.Locked = False
            End If
        End If
    End If
End Sub

[kennethshuen]

差不多，可以将sheet1的Row都一起锁上吗？

[Paul_Hossler]

@kennethshuen --

1. I added CODE tags to your macro in post #1 -- you can use the [#] icon to insert CODE tags and paste the macro between to format it and set it off

2. Could you include a English version in your response also, so others can follow along? Thanks

[大灰狼1976]

@kennethshuen
sheet1里面没有CheckBox，根据什么条件来锁？
There is no CheckBox in sheet1. Under what conditions to lock?

--Okami

[kennethshuen]

Thanks, Paul

I was just asking how to lock sheet 1 as well.

[Paul_Hossler]

A few tweaks to the above code, based on the way I read the requirement

I think the Change event goes in Sheet1, and I made it check Sheet2 B2 to see if the check box as on or off

Not sure, but it seems you always had Unprotected Sheet1

You'll need to play with this to get it final for your needs


Sheet1 Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
   If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row < 4 Then Exit Sub
    If Len(Worksheets("Sheet2").Range("B2").Value) = 0 Then Exit Sub
    
    Me.Unprotect Password:="123"
    
    If Len(Target.Value) > 0 Then
        Target.EntireRow.Locked = True
        Me.Protect Password:="123"
    End If
End Sub

Option Explicit


Sub CheckBox_Date_Stamp()
    Dim xChk As CheckBox
    Set xChk = ActiveSheet.CheckBoxes(Application.Caller)
    
    With xChk.TopLeftCell.Offset(, 1)
        Worksheets("Sheet2").Unprotect Password:="123"
        If xChk.Value = xlOff Then
            .ClearContents
        Else
            .Value = Date
        End If
        Worksheets("Sheet2").Protect Password:="123"
    End With
End Sub

[Paul_Hossler]

Thanks, Paul

I was just asking how to lock sheet 1 as well.

I think my suggestions do that since I move the Change event handler to Sheet1 and the "Me.Protect" now refers to that sheet

Since

CheckBox_Date_Stamp() is a 'normal' sub ('Me.' doesn't work), I added explicit Worksheets("Sheet2").Protect to that one

[kennethshuen]

I have uploaded a more updated excel file that may help explaining a bit more. So basically sheet 2 is for internal purpose while sheet 1 will be pasted on e.g. for public or other departments to view. If sheet 2 is submitted and a submission date is assigned then that row on sheet 2 will be locked e.g. row for document A in sheet two, and the row for document A in sheet 1 has to be locked as well.

[Paul_Hossler]

I sort of think I kinda understand a little

This is probably the only macro you need - i.e. no Sheet _Change event

All the cells on both sheets start out as .Locked = False, and it's your macro that sets .Locked = True for the required rows

Option Explicit


Sub CheckBox_Date_Stamp()
    Dim xChk As CheckBox
    Dim xChkRow As Long


    Set xChk = ActiveSheet.CheckBoxes(Application.Caller)
    xChkRow = xChk.TopLeftCell.Row
    
    ActiveSheet.Unprotect Password:="123"
    Worksheets("Sheet1").Unprotect Password:="123"
    
    With xChk.TopLeftCell.Offset(, 1)
        If xChk.Value = xlOff Then
            .ClearContents
            ActiveSheet.Rows(xChkRow).Locked = False
            Worksheets("Sheet1").Cells(xChkRow - 1, 2).ClearContents
            Worksheets("Sheet1").Rows(xChkRow - 1).Locked = False
        Else
            .Value = Date
            ActiveSheet.Rows(xChkRow).Locked = True
            Worksheets("Sheet1").Cells(xChkRow - 1, 2).Value = "Submitted"
            Worksheets("Sheet1").Rows(xChkRow - 1).Locked = True
        End If
    End With
    
    Worksheets("Sheet1").Protect Password:="123"
    ActiveSheet.Protect Password:="123"
End Sub

[大灰狼1976]

Please refer to the attachment.
But I think Sheet1 uses all the formulas, and it's better to lock the entire worksheet directly.
但是我感觉sheet1全部使用公式，直接锁定整个工作表更好。

[kennethshuen]

Thank you guys, it works perfectly so far. Will let you know of any latent problem if there is any

[Aussiebear]

My English is terrible.

Your English is far better than you imply.

[大灰狼1976]

@Aussiebear
I used online translation.