Locking A cell determined by data

L

Learning VBA

Is there a way to lock a cell if it does not contain data?

Example

I have a range of cells:
J10 though J25
The cells currently have "Add Name" these cells are unlocked for input.

If they are changed and no longer have "Add Name" I would like to lock any
cell that has changed.
 
P

Per Jessen

Hi

Something like this (this is an event code and has to be inserted in the
code sheet for the desired sheet):

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Intersect(Target, Range("J10:J25"))
If Not isect Is Nothing Then
If Target.Value <> "Add Name" Then
ActiveSheet.Unprotect Password:="JustMe"
Target.Locked = True
ActiveSheet.Protect Password:="JustMe"
End If
End If
End Sub

Regards,
Per
 
L

Learning VBA

I sent this yesterday but never showed up in the newsgroup.



put this in the code and No Matter what is in the target it locks the
cell.

I just put in 1 cell "Add Name 1: " and it locked
All other cells in the range stayed unlocked.



If Not isect Is Nothing Then
If Left(Target.Value, 9) <> "Add Name" Then
 
L

Learning VBA

Sorry I figured it out.
I don't know how to count.

Also added
else target.locked = false


Thanks for your help.
 
L

Learning VBA

I have this in a worksheet Module.
I have been trying to figure this out for over 2 hours and am having trouble
getting it to work.

I actually have 2 ranges on each sheet and 31 sheets named 01 - 31
The first range is T13:T22 and the second range is T46:T55
I thought I would work on the first range first before tackling the second.


Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Intersect(Target, Range("T13:T22"))
If Not isect Is Nothing Then
If Left(Target.Value, 8) <> "Add Name" Then
ActiveSheet.Unprotect Password:="Pass"
Target.Locked = True
Else
Target.Locked = False
End If
End If
ActiveSheet.Protect Password:="Pass"
End Sub

Each range has the following
Add Name 1 :
Add Name 2 :
And so on

If the Add Name is no longer there I would like that cell to lock, otherwise
leave it unlocked.
 
G

Gord Dibben

Works for me.

I started with all cells on the sheet unlocked.

As I changed the cell values in the ranges, those cells locked.

For 31 worksheets you would place the code into Thisworkbook module so's it
runs on every sheet..............assuming the ranges are same on each sheet.

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
Set isect = Intersect(Target, Range("T13:T22,T46:T55"))
If Not isect Is Nothing Then
If Left(Target.Value, 8) <> "Add Name" Then
ActiveSheet.Unprotect Password:="Pass"
Target.Locked = True
'you don't need the Else if you start with all cells(or at least those in
the ranges) unlocked
' Else
' Target.Locked = False
End If
End If
ActiveSheet.Protect Password:="Pass"
End Sub


Gord Dibben MS Excel MVP
 
L

Learning VBA

I just copied and pasted this.
Still does nothing.

I also figured I did not need to unprotect where it is already unprotected.

I am using Excel 2007 in 2003 mode if that helps.



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set isect = Intersect(Target, Range("T13:T22,T46:T55"))
If Not isect Is Nothing Then
If Left(Target.Value, 8) <> "Add Name" Then
' ActiveSheet.Unprotect Password:="Pass"
Target.Locked = True
'you don't need the Else if you start with all cells(or at least those in
the ranges) unlocked
' Else
' Target.Locked = False
End If
ActiveSheet.Protect Password:="Pass"
End If

End Sub
 
G

Gord Dibben

Have you enabled macros?

Do regular macros in that workbook operate OK?

Do you have any other event code that fails to run?

Have events been disabled?

Stick this in the Immediate Window and hit Enter

Application.EnableEvents = True


Gord
 
L

Learning VBA

Should have mentioned I do not want to use it in the workbook module as I
have another 30 sheets not formatted the same way.
So put this back in

Private Sub Worksheet_Change(ByVal Target As Range)
 
L

Learning VBA

I run about 50 macros in the workbook and about 10 on that sheet that I am
testing it on.
All macros work perfectly.

I have 2 macros in the sheet module, Here they are:

Private Sub WorkSheet_Change(ByVal Target As Range)
Set isect = Intersect(Target, Range("T13:T22,T46:T55"))
If Not isect Is Nothing Then
If Left(Target.Value, 8) <> "Add Name" Then
' ActiveSheet.Unprotect Password:="Pass"
Target.Locked = True
'you don't need the Else if you start with all cells(or at least those in
the ranges) unlocked
' Else
' Target.Locked = False
End If
ActiveSheet.Protect Password:="Pass"
End If

End Sub

Private Sub Worksheet_Calculate()
On Error GoTo stopit
Applicatio.EnableEcents = False
If ActiveSheet.Tab.ColorIndex = 3 Then GoTo stopit
With Me.Range("B190")
If .Value > 0 Then
ActiveSheet.Tab.ColorIndex = 6
Else
If .Value < 0 Then
ActiveSheet.Tab.ColorIndex = 3
Else
ActiveSheet.Tab.ColorIndex = 0
End If
End If
End With
stopit:
Application.EnableEvents = True
End Sub
 
G

Gord Dibben

All I can see, if you copied and pasted what you have, is that you need to
rem out the line that should be showing red if you haven't already done so.

the ranges) unlocked

Are you sure you have no leading spaces in Add Name xx cells?

Did you try to re-enable events?

Does the worksheet_calculate code run?


Gord
 
L

Learning VBA

Ranges are unlocked = Yes . and stay unlocked after entering a name
Checked for extra spaces = none.
Re-enable events = yes
The worksheet_Calculate = works fine.

Could it be that the file is too large? It is over 4MB with many macros.
 
G

Gord Dibben

I'm not sure why that particular event won't fire.

If you want to send the workbook to me, feel free.

gorddibbATshawDOTca chnage the obvious.


Gord
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top