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.:biglaugh: