protect cells based on another cell

N

Neil

I would like to protect cells once a value has been placed in another cell.
E.G. I have a sign off date column and once a value has been entered I want
the cells to the left to be protected. Is this Possible?
 
G

Gary L Brown

Hi Neil,
First, the way Excel works is you unprotect
the cells you want to be able to change then you
protect the worksheet.

To unprotect a range of cells, select the
range, right-click,
Format Cells>Protection then unclick the 'Locked' checkbox.

To protect the worksheet,
Tools>Protection>Protect Sheet.

Now, I think the scenerio you want is...
Let's assume that Cells 'A3' and 'B3' are
unprotected in 'SHEET1'.
A3 has some data in it.
You enter a date in B3 and A3 automatically
becomes protected.
If you delete the date in B3, A3 automatically
becomes unprotected.

To do this, you must put a macro in the
'SelectionChange' section of the SHEET1.
1) Get into the Visual Basic Editor:
Tools>Macro>Visual Basic Editor
2) Get to SHEET1:
the 'Project - VBAProject' window will
be on your left. If it isn't,
VIEW>Project Explorer
Open up the 'Microsoft Excel Objects' for
your workbook
Double left-click on the 'Sheet1(Sheet1) object
3) Enter the code in SHEET1:
The right side of the window will show
'(General)' and '(Declarations)'
Drop down the box with GENERAL and
select 'WORKSHEET'.
Drop down the box with Declarations and
select 'SelectionChange'.
Anything you put in this section will happen
everytime you change your selection on SHEET1
4) The code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Len(Range("B3").Value) <> 0 Then
Range("A3").Locked = True
Else
Range("A3").Locked = False
End If
End Sub


- Every time you move your cursor to another cell,
Excel will look at B3, check to see if anything
is in B3. If there is anything in B3, Excel
will automatically protect cell A3. If there
is nothing in B3, Excel will automatically
unprotect cell A3.


HTH,
 
N

Neil

Hi Gary,

Really apprechiate your help.

Apologies but I didn't explain my scenario correctly. I am working with a
list of data in excel and want this code to run across all rows. e.g. Each
row has a different variable which will be signed off by entering a value in
column B and therefore need protecting when the value in column B in entered.
Is this possible?

Thanks,

Neil.
 
G

Gary L Brown

This macro should take care of that scenerio. A loop is needed to check all
cells in Col B. I've indicated 2 options for checking Col B.

'/===============================================/
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rCell As Range, rngB As Range

On Error GoTo err_Sub

Set rngB = Range("B:B")

'alternate to looking at all cells in Col B including
' possible headers that you don't want protected is...
' Set rngB = Range("B2:B10000")


'loop through all cells in Col B
For Each rCell In rngB
'in order to not check all 65000 lines each time
' check to see if you are inside 'used' part
' of worksheet. If not, stop processing
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If

'check all cells in Col B for an entry in each cell
If Len(rCell.Value) <> 0 Then
'if there is an entry, protect the cell in Col A
Range(rCell).Offset(-1, 0).Locked = True
Else
'if there is NO entry, unprotect the cell in Col A
Range(rCell).Offset(-1, 0).Locked = False
End If

Next rCell

exit_Sub:
On Error Resume Next
Set rngB = Nothing
Exit Sub

err_Sub:
GoTo exit_Sub

End Sub
'/===============================================/


HTH,
 
D

Duncan

Gary,

I have been working with Neil on this issue. Thanks a lot for supplying the
code below. However, we do not seem to be able to get it to work. When you
enter a value in cell b, you can still edit cell a. As Neil explained
previoisly we need the code to lock the cell to its right when a value is
entered into it.

Also, the sheet is question it protected already as we do not want cetain
cells to be edited. Will this affect the code in anyway?
 
G

Gary L Brown

Hi Duncan,
Serves me right for throwing you a down and dirty code. :O>
I've changed the code significantly, added password protection, etc to the
code to make it a lot more robust.

Because of this, I have added two macros.
'Protect_Unprotect_TheCells'
'ProtectTheCells'

'Protect_Unprotect_TheCells' is the general routine that protects /
unprotects the worksheet so that the cell protection/unprotection can most
easily be accomplished.
This routine then calls the 'ProtectTheCells' routine which is what you are
most interested in.

I have taken the programming out of the 'Worksheet_SelectionChange' event
to make the flow better but more importantly, if you want to unportect the
worksheet for a period of time while you edit it, you can easily simply
comment out the one line of code..."Call Protect_Unprotect_TheCells" instead
of having to comment out a whole slew of lines.

Hope this is what you're looking for. If you want to reach me directly, I
am currently consulting at ge.com, see my email below (take out the _NOSPAM
part).

HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".


'/============================================/
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Protect_Unprotect_TheCells
End Sub
'/============================================/
Private Sub ProtectTheCells()
Dim rCell As Range, rngB As Range

On Error GoTo err_Sub

Set rngB = Range("B:B")

'alternate to looking at all cells in Col B including
' possible headers that you don't want protected is...
' Set rngB = Range("B2:B10000")

'loop through all cells in Col B
For Each rCell In rngB
'in order to not check all 65000 lines each time
' check to see if you are inside 'used' part
' of worksheet. If not, stop processing
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If

'check all cells in Col B for an entry in each cell
If Len(rCell.Value) <> 0 Then
'if there is an entry, protect the cell in Col A
rCell.Offset(0, -1).Locked = True
Else
'if there is NO entry, unprotect the cell in Col A
rCell.Offset(0, -1).Locked = False
End If

Next rCell

exit_Sub:
On Error Resume Next
Set rngB = Nothing
Exit Sub

err_Sub:
GoTo exit_Sub

End Sub
'/============================================/
Private Sub Protect_Unprotect_TheCells()
'template for unprotecting/protecting worksheet
Dim blnProtectContents As Boolean
Dim blnProtectDrawingObjects As Boolean
Dim blnProtectScenarios As Boolean
Dim strPassword As String

'set default for whether worksheet is protected or not
blnProtectContents = False
blnProtectDrawingObjects = False
blnProtectScenarios = False
strPassword = ""

'check if worksheet is unprotected
' if it's protected, get various information
On Error Resume Next
If Application.ActiveSheet.ProtectContents = True Then
blnProtectContents = True
If Application.ActiveSheet.ProtectDrawingObjects = True Then
blnProtectDrawingObjects = True
End If
If Application.ActiveSheet.ProtectScenarios = True Then
blnProtectScenarios = True
End If
'try to unprotect worksheet
ActiveSheet.Protect Password:=strPassword, _
DrawingObjects:=False, _
Contents:=False, _
Scenarios:=False
'if try to unprotect worksheet didn't work
' then ask for password
If Application.ActiveSheet.ProtectContents = True Then
'still protected so try password
strPassword = InputBox("Enter Password: " & vbCr & vbCr & _
"If there is no password, press ENTER." & vbCr & vbCr & _
"ONLY enter Password if source of this macro is TRUSTED!!!", _
"Password to Unprotect Worksheet...", "")
ActiveSheet.Unprotect Password:=strPassword
'password didn't work - still not unprotected so stop process
If Application.ActiveSheet.ProtectContents = True Then
Exit Sub
End If
End If
End If
On Error GoTo 0

'call the desired routine
Call ProtectTheCells

'set worksheet back to original protected/unprotected state
On Error Resume Next
ActiveSheet.Protect Password:=strPassword, _
DrawingObjects:=blnProtectDrawingObjects, _
Contents:=blnProtectContents, Scenarios:=blnProtectScenarios

End Sub
'/============================================/
 
G

Gary L Brown

By the way, I'm on the East Coast of the US so I think I'm about 5 hours
behind you.
 
Top