View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Mike H Mike H is offline
external usenet poster
 
Posts: 11,501
Default Lock or Unlock Range of Cells on Worksheet_Change Event

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

"Grahame Coyle" wrote:

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 D10:D16

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,D10: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


' 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