Lock or Unlock Range of Cells on Worksheet_Change Event

[Grahame Coyle]

Hi

I'm trying to make a range of cells Lock or Unlock depending on the status
of another cell, all fired by Worksheet_Change. The cells I need to lock
and unlock start out being locked when the worksheet is opened, that's their
normal state. I've tried a few different methods so far with no success. I
think I'm missing something to do with correctly firing the Worksheet_Change
event.

A rough outline (not real code of course) of what I need to do would be as
follows.

Dim StatusCell ' The cell that will change value - actually F3
Dim Range ' The cells I need to lock or unlock - actually D1016

If StatusCell = "YES" Then
Range.Locked = False
Elseif StatusCell <> "YES" Then
Range.Locked = True
End If

My current Worksheet_Change code is below. The StatusCell mentioned above
is also part of a the first bit of code below, the CapitalCase code. Any
help would be gratefully received.

Grahame


Private Sub Worksheet_Change(ByVal Target As Range)

' Force Range Cells to Uppercase
Dim CapitalCase As Range

Set CapitalCase = Intersect(Me.Range("B6,F3,F6,B10:B16,C10:C16,D1016"),
Target)
If CapitalCase Is Nothing Then
Exit Sub
Else
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False

If Application.WorksheetFunction.IsText(Target.Value) Then
Target.Value = UCase(Target.Value)
End If

Application.EnableEvents = True
End If


' Force Sheet Name Change to the Employee Name
Dim WorkSheetName As Range

Set WorkSheetName = Intersect(Me.Range("F6"), Target)
If WorkSheetName Is Nothing Then
Exit Sub
Else
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Name = Range("F6")
Application.EnableEvents = True
End If

End Sub

 

[Mike H]

Hi,

You can incorporate this into your worksheet change routine. F3 must of
course be unlocked at all times for it to work.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$3" And UCase(Target.Value) = "YES" Then
ActiveSheet.Unprotect Password:="xxx"
Range("D1016").Locked = False
ActiveSheet.Protect Password:="xxx"
ElseIf Target.Address = "$F$3" And UCase(Target.Value) <> "YES" Then
ActiveSheet.Unprotect Password:="xxx"
Range("D1016").Locked = True
ActiveSheet.Protect Password:="xxx"
End If
End Sub

Mike

 

[Grahame Coyle]

Hi Mike

That's perfect. I tweaked it around a little bit and it's working just
fine.

One thing I've noticed however is that when I delete the entry in cell F3
(where "YES" is the trigger text) using the DELETE key on my keyboard, the
code to re-lock the Range (D1016) doesn't fire. If however I hit the
BACKSPACE key instead to remove the word "YES", the re-lock code fires
properly.

I'm guessing this means that using the DELETE key to clear cell F3 doesn't
constitute an "Onchange" event in Excel. Would you have any suggestions for
a method to address this?

Grahame

 

[Grahame Coyle]

Hi Mike

The code you gave me works great, but I've hit a problem with how to
incorporate it into my Worksheet_Change Sub. I have a few other OnChange
events that I want to run.

CapitalCase is to change the specified range of cells to UCase
ProtectCells is you code, dressed up a little
EmployeeSheetName is a function to rename the Active Sheet when cell F6 is
changed.

All of the above functions work independently, but when I place them in the
Worksheet_Change code the EmployeeSheetName function fails to fire. If I
move the ProtectCells code to below the EmployeeSheetName code then it faisl
to fire, but the sheet naming function starts working again.

I'm guessing that there's something in the way I've set up the three
OnChange events code that is stopping on or other firing, al due to where
they are positioned in the code order. I can make it all work if I put
everything together under the CapitalCase section, but I like the idea of
having each event as a separate bit of code. Maybe that's not allowed?

My current (not quite working all together) Worksheet_Change code is below.
Sorry to ask, but do you have any suggestions how I could fix this but still
keep all of code blocks separated?

TIA

Grahame


Private Sub Worksheet_Change(ByVal Target As Range)

' CHANGES A RANGE OF CELLS TO UPPERCASE
Dim CapitalCase As Range
Set CapitalCase =
Intersect(Me.Range("$B$6,$F$3,$F$6,$B$10:$B$16,$C$10:$C$16,$D$10:$D$16"),
Target)
If CapitalCase Is Nothing Then
Exit Sub
Else
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False

If Application.WorksheetFunction.IsText(Target.Value) Then
Target.Value = UCase(Target.Value)
End If

Application.EnableEvents = True
End If


' PROTECT CELLS
Dim ProtectCells As Range
Set ProtectCells = Intersect(Me.Range("$F$3"), Target)
If ProtectCells Is Nothing Then
Exit Sub
Else
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Address = "$F$3" And UCase(Target.Value) = "YES" Then
ActiveSheet.Unprotect Password:="jess"
Range("D1016").Locked = False
ActiveSheet.Protect Password:="jess"
ElseIf Target.Address = "$F$3" And UCase(Target.Value) <> "YES" Then
ActiveSheet.Unprotect Password:="jess"
Range("D1016").Locked = True
ActiveSheet.Protect Password:="jess"
End If
Application.EnableEvents = True
End If


' CHANGES THE SHEET NAME TO THE EMPLOYEE NAME
Dim EmployeeSheetName As Range
Set EmployeeSheetName = Intersect(Me.Range("$F$6"), Target)
If EmployeeSheetName Is Nothing Then
Exit Sub
Else
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Name = Range("$F$6")
Application.EnableEvents = True
End If


End Sub