View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Grahame Coyle Grahame Coyle is offline
external usenet poster
 
Posts: 3
Default Lock or Unlock Range of Cells on Worksheet_Change Event

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("D10:D16").Locked = False
ActiveSheet.Protect Password:="jess"
ElseIf Target.Address = "$F$3" And UCase(Target.Value) < "YES" Then
ActiveSheet.Unprotect Password:="jess"
Range("D10:D16").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







"Mike H" wrote in message
...
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("D10:D16").Locked = False
ActiveSheet.Protect Password:="xxx"
ElseIf Target.Address = "$F$3" And UCase(Target.Value) < "YES" Then
ActiveSheet.Unprotect Password:="xxx"
Range("D10:D16").Locked = True
ActiveSheet.Protect Password:="xxx"
End If
End Sub

Mike