code to lock a range of cells after completing

Cablek

Board Regular
Joined
Nov 22, 2017
Messages
51
I have a code to automatically enter the date if any data is entered into cells B14 to B100

Private Sub Worksheet_change(ByVal Target As Excel.Range)
If (Target.Count = 1) And _
(Not Intersect(Target, [B14:B10000]) Is Nothing) Then _
Target.Offset(0, -1) = Date
End Sub

but now I want the user to enter date into B14, C14 and E14 THEN once completed I want to LOCK those cells
then user can come back later and enter B15,C15 and E15 right down to B100, C100 and E100

A B C&D E
[TABLE="width: 395"]
<colgroup><col span="3"><col span="2"></colgroup><tbody>[TR]
[TD="colspan: 5"][/TD]
[/TR]
[TR]
[TD]
Date[/TD]
[TD]Qty built[/TD]
[TD="colspan: 2"]PO#[/TD]
[TD]built by[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD="colspan: 2"] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD="colspan: 2"] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD="colspan: 2"] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]
Does this make any sense?
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Hi Cablek,

Yes, it makes sense, but you have to protect the whole sheet, and then specify which cells are locked and unlocked (and are therefore affected by the sheet protection).

By default, all cells are locked, and the sheet is of course unprotected.

To unlock all you can use

Code:
Sheets("[I]SheetName"[/I]).Cells.Locked = false

to lock specific cells you can use:

Code:
Sheets("[I]SheetName[/I]").Range("C14:D15").Locked = True
'Or in a change event sub,
Target.Locked = True

and then to protect the sheet:

Code:
Sheets("[I]SheetName[/I]").Protect

Make sure you use 'Sheets("SheetName").Unprotect' at the start of the sub too, or it might fail.

Hope that helps.

Thanks
JB
 
Upvote 0
Hi JB, thanks for the quick reply... i'm still unsure as how to add this to the existing code... and just to make sure we are on the same page I want to cell to lock after he moves on to the next cell but if there is nothing I need him to be able to add data.

Sorry I really feel like a newbie here
 
Upvote 0
Don't apologise, it's fine.

To determine where to put the code we need to think about it logically.

So the existing value changes should probably happen before we lock any cells, so the first line we enter is actually immediately before 'End Sub'.

Add a new line, and put

Code:
'I am unsure if you want to lock the date cell, or the edited cell, or both, so here goes:

'For the date cell:
Target.offset(0,-1).locked = True

'Or for the edited cell:
Target.Locked = True

'Or for both:
Target.offset(0,1).resize(1,2).Locked = True


Now you need to protect the sheet so the locked cells actually 'lock'.
Add this after the previous line you entered, so again immediately before 'End Sub'

Code:
Me.Protect

Now as I mentioned above, you need to unprotect the sheet at the start also, so add a new line beneath line one - beneath "Private Sub...." and add:

Code:
Me.Unprotect


Finally you need to unlock all cells. Rather than bother with code, just select all cells on the sheet with the button thingy, left of the header for column A, go into format cells, under protection uncheck 'locked'.

And I think that's it!

Let me know how you get on.

Cheers
JB
 
Upvote 0
Hi JB it added the date and locked the cell :) but when I moved on to cell D14 to add more info I got an error

Private Sub Worksheet_change(ByVal Target As Excel.Range)
Me.Unprotect


If (Target.Count = 1) And _
(Not Intersect(Target, [B14:B10000]) Is Nothing) Then _
Target.Offset(0, -1) = Date
Target.Offset(0, 1).Resize(1, 2).Locked = True
Me.Protect
End Sub

error at Target.Offset(0, 1).Resize(1, 2).Locked = True
 
Upvote 0
I see,

I didn't notice the "_" after "Then". This makes it a one line if statement, To make it a multi-line statement, we need and 'End If' to say where it finishes. Also, for efficiency we should really move the unprotect/protect inside the if statement, as we don't need it to unprotect unless the criteria is met.

So you end up with this:

Code:
If (Target.Count = 1) And (Not Intersect(Target, [B14:B10000]) Is Nothing) Then
   Me.Unprotect
   Target.Offset(0, -1) = Date
   Target.Offset(0, 1).Resize(1, 2).Locked = True
   Me.Protect
End If

I don't know what is with that first window. it won't go away, just ignore it!
 
Last edited:
Upvote 0
Sorry,

The two Offsets are different. Change so both have -1 in them, not 1. and make the changes I suggested in previous post also.

Good luck - when I can't tell the difference between + and -, it's bedtime! :biggrin:

Cheers
 
Upvote 0
Hey BJ... I truely appreciate your help and at this point I am totally lost in this code so I can't really figure out where the error is coming from but here is my code

Private Sub Worksheet_change(ByVal Target As Excel.Range)
If (Target.Count = 1) And (Not Intersect(Target, [B14:B10000]) Is Nothing) Then
Me.Unprotect
Target.Offset(0, -1) = Date
Target.Offset(0, -1).Resize(1, 2).Locked = True
Me.Protect
End If
End Sub

Again I am getting an error at Target.Offset (o, -1).Resize(1, 2).Locked = True
 
Upvote 0
What is the error? I notice the code looks fine, but in the error line you have offset (o,-1). i.e. the letter, not the number. Check this is a zero in the code.
 
Upvote 0
sorry it's actually a 0 in the code

error is a Run-time error "1004"
unable to set the Locked property of the Range class
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,210
Members
453,023
Latest member
alabaz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top