View Full Version : VBA Lock rows upon checkbox click on multi-sheets
kennethshuen
04-02-2019, 12:44 AM
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
04-02-2019, 12:58 AM
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
04-02-2019, 01:14 AM
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
04-02-2019, 01:40 AM
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
04-02-2019, 04:29 AM
差不多,可以将sheet1的Row都一起锁上吗?
Paul_Hossler
04-02-2019, 05:24 AM
@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
04-02-2019, 05:42 AM
@kennethshuen
sheet1里面没有CheckBox,根据什么条件来锁?
There is no CheckBox in sheet1. Under what conditions to lock?
--Okami
kennethshuen
04-02-2019, 05:43 AM
Thanks, Paul
I was just asking how to lock sheet 1 as well.
Paul_Hossler
04-02-2019, 05:51 AM
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
04-02-2019, 06:24 AM
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
04-02-2019, 05:20 PM
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
04-02-2019, 06:41 PM
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
04-02-2019, 07:46 PM
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
04-02-2019, 10:43 PM
Thank you guys, it works perfectly so far. Will let you know of any latent problem if there is any
Aussiebear
04-03-2019, 02:27 AM
My English is terrible.
Your English is far better than you imply.
大灰狼1976
04-03-2019, 04:47 AM
@Aussiebear
I used online translation.:biglaugh:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.