Macro Doesn't Work When Worksheet Protected

[xl@lf]

Hello,

I have a worksheet containing VBA code with the command
"Worksheet_Change(ByVal Target As Range)".

When I protect the worksheet the command will not run.

Any ideas would be appreciated..

Thank you

 

[James Ravenswood]

Hello,

I have a worksheet containing VBA code with the command
"Worksheet_Change(ByVal Target As Range)".

When I protect the worksheet the command will not run.

Any ideas would be appreciated..

Thank you

Post yoour full code.

 

[xl@lf]

Thanks for your help James. Here is the code.




' Beginning area of code to automatically enable a worksheet macro
when input values are changed

Private Sub Worksheet_Change(ByVal Target As Range)

Const WS_RANGE As String = "input"

On Error GoTo ws_exit:

Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target




Dim cTop As Long
Dim cLeft As Long
Dim rad As Long


Application.ScreenUpdating = False



If Range("Number_of_CLs") > 0 Then
Range("Number_of_CLs:All_Encapsulated?").EntireRow.Hidden = False
Else
Range("Number_of_CLs:Size_encap3").Offset(1,
0).EntireRow.Hidden = True
End If


If Range("Num_Configurations") = 1 Then
Range("num_in_encap2:Size_encap2").ClearContents
Range("num_in_encap3:Size_encap3").ClearContents
Range("num_in_encap2:clearance3").EntireRow.Hidden = True

ElseIf Range("Num_Configurations") = 2 Then
Range("num_in_encap3:Size_encap3").ClearContents
Range("num_in_encap3:clearance3").EntireRow.Hidden = True

End If




If Range("All_Encapsulated?") = "Yes" Then
Range("Num_Encapsulated:clearance").EntireRow.Hidden = True
Range("Num_Configurations").EntireRow.Hidden = False
ElseIf Range("All_Encapsulated?") = "No" Then

Range("Num_Encapsulated:Num_Configurations").EntireRow.Hidden = False
ElseIf Range("All_Encapsulated?") = "" Then

Range("Num_Encapsulated:Size_encap3").EntireRow.Hidden = True
End If




If Range("Num_Configurations") = "" Or Range("Num_Configurations") =
"0" Then
Range("num_in_encap1:clearance3").EntireRow.Hidden = True
ElseIf Range("Num_Configurations") = 1 Then
Range("blank6:num_in_encap1").EntireRow.Hidden = False
Range("encap1_Num_quart:clearance3").EntireRow.Hidden =
True
ElseIf Range("Num_Configurations") = 2 Then
Range("blank6:num_in_encap1").EntireRow.Hidden =
False
Range("blank1:num_in_encap2").EntireRow.Hidden =
False

Range("encap1_Num_quart:clearance1").EntireRow.Hidden = True

Range("encap2_Num_quart:clearance3").EntireRow.Hidden = True
ElseIf Range("Num_Configurations") = 3 Then

Range("blank6:num_in_encap1").EntireRow.Hidden = False

Range("blank1:num_in_encap2").EntireRow.Hidden = False

Range("blank2:num_in_encap3").EntireRow.Hidden = False

Range("encap1_Num_quart:clearance1").EntireRow.Hidden = True

Range("encap2_Num_quart:clearance2").EntireRow.Hidden = True

Range("encap3_Num_quart:clearance3").EntireRow.Hidden = True
End If


For x = 1 To 3
If Range("num_in_encap" & x) > 0 Then
Range("encap" & x & "_Num_quart:config" & x).EntireRow.Hidden = False
Else
Range("encap" & x & "_Num_quart:std_or_custom" & x).ClearContents
End If


If Range("num_in_encap" & x) = "" Then
ElseIf Range("num_in_encap" & x) = "1" Then
Range("config" & x).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$77:$R
$79"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ElseIf Range("num_in_encap" & x) >= "1" Then
Range("config" & x).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$76:$R
$76"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
Next x



For x = 1 To 3
y = 1
Do Until y - 1 = Range("num_in_encap" & x) Or Range("num_in_encap" &
x) = ""
If Range("num_in_encap" & x) = y Then

Range("encap" & x & "_Num_quart").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$80:$R
$8" & y & ""
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("encap" & x & "_Num_3eights").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$80:$R
$8" & y & ""
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("encap" & x & "_Num_half").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$80:$R
$8" & y & ""
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

End If
y = y + 1
Loop
Next x




y = 1
Do Until y - 1 = Range("Num_Without_Encapsulation") Or
Range("Num_Without_Encapsulation") = ""
If Range("Num_Without_Encapsulation") = y Then

Range("non_encap1_Num_quart").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$80:$R
$8" & y & ""
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("non_encap1_Num_3eights").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$80:$R
$8" & y & ""
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("non_encap1_Num_half").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$R$80:$R
$8" & y & ""
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

End If
y = y + 1
Loop






For x = 1 To 3
If Range("config" & x) <> "" Then
Range("std_or_custom" & x).EntireRow.Hidden = False
Else
Range("std_or_custom" & x).EntireRow.Hidden = True
Range("encap" & x & "_width").EntireRow.Hidden = True
Range("encap" & x & "_height").EntireRow.Hidden = True
Range("Size_encap" & x).EntireRow.Hidden = True

End If
Next x


For x = 1 To 3
If Range("std_or_custom" & x) = "Standard Size" Then
Range("encap" & x & "_width:encap" & x &
"_height").EntireRow.Hidden = True
Range("Size_encap" & x).EntireRow.Hidden = False
Range("radius" & x).EntireRow.Hidden = False
Range("clearance" & x).EntireRow.Hidden = False

ElseIf Range("std_or_custom" & x) = "Custom Size" Then
Range("encap" & x & "_width:clearance" & x).Select
Selection.EntireRow.Hidden = False
End If
Next x


If Range("Num_Without_Encapsulation") <> "" And
Range("Num_Without_Encapsulation") = Range("Number_of_CLs") Then
Range("below:end").EntireRow.Hidden = False

ElseIf Range("Num_Configurations") = 3 And Range("std_or_custom3") <>
"" And Range("std_or_custom2") <> "" And Range("std_or_custom1") <> ""
Then
Range("below:end").EntireRow.Hidden = False

ElseIf Range("Num_Configurations") = 2 And Range("std_or_custom2") <>
"" And Range("std_or_custom1") <> "" Then
Range("below:end").EntireRow.Hidden = False

ElseIf Range("Num_Configurations") = 1 And Range("std_or_custom1") <>
"" Then
Range("below:end").EntireRow.Hidden = False

End If



'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________



'Call size_of_encapsulation.size_of_encapsulation


For x = 1 To 3

If Range("std_or_custom" & x) = "Custom Size" Then
Range("size_encap" & x) = Range("encap" & x & "_width").Value & "
X " & Range("encap" & x & "_height").Value
Else

If Range("type_encap" & x) = "Round" And Range("std_or_custom"
& x) = "Standard Size" Then
If Range("encap" & x & "_Num_quart") = 1 Then
Range("size_encap" & x) = "0.433"
ElseIf Range("encap" & x & "_Num_3eights") = 1 Then
Range("size_encap" & x) = "0.535"
ElseIf Range("encap" & x & "_Num_half") = 1 Then
Range("size_encap" & x) = "0.535"
End If


ElseIf Range("type_encap" & x) = "Square" And
Range("std_or_custom" & x) = "Standard Size" Then
If Range("encap" & x & "_Num_quart") = 1 Then
Range("size_encap" & x) = "0.433" & " X " & "0.433"
ElseIf Range("encap" & x & "_Num_3eights") = 1 Then
Range("size_encap" & x) = "0.535" & " X " & "0.535"
ElseIf Range("encap" & x & "_Num_half") = 1 Then
Range("size_encap" & x) = "0.660" & " X " & "0.660"
End If
Else
End If



If Range("type_encap" & x) = "Flatpack" And
Range("std_or_custom" & x) = "Standard Size" Then

If Range("num_in_encap" & x) = 2 Then
If Range("encap" & x & "_Num_quart") = 2 Then
Range("size_encap" & x) = "0.710" & " X " &
"0.433"
ElseIf Range("encap" & x & "_Num_3eights") = 2
Then
Range("size_encap" & x) = "0.960" & " X " &
"0.535"
ElseIf Range("encap" & x & "_Num_half") = 2 Then
Range("size_encap" & x) = "1.20" & " X " &
"0.660"

ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 1 Then
Range("size_encap" & x) = "0.825" & " X " &
"0.535"
ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_half") = 1 Then
Range("size_encap" & x) = "0.960" & " X " &
"0.660"
ElseIf Range("encap" & x & "_Num_3eights") = 1 And
Range("encap" & x & "_Num_half") = 1 Then
Range("size_encap" & x) = "1.09" & " X " &
"0.660"

Else
End If
End If


If Range("num_in_encap" & x) = 3 Then
If Range("encap" & x & "_Num_quart") = 3 Then
Range("size_encap" & x) = "0.990" & " X " &
"0.433"
ElseIf Range("encap" & x & "_Num_3eights") = 3
Then
Range("size_encap" & x) = "1.365" & " X " &
"0.535"
ElseIf Range("encap" & x & "_Num_half") = 3 Then
Range("size_encap" & x) = "1.74" & " X " &
"0.660"


ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 1 And Range("encap" & x &
"_Num_half") = 1 Then
Range("size_encap" & x).Value = (0.25 + 0.375
+ 0.5) + 0.24 & " X " & "0.660"
ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_half") = 2 Then
Range("size_encap" & x).Value = (0.25 + 0.5 +
0.5) + 0.24 & " X " & "0.660"
ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 2 Then
Range("size_encap" & x).Value = (0.25 + 0.375
+ 0.375) + 0.24 & " X " & "0.535"
ElseIf Range("encap" & x & "_Num_quart") = 2 And
Range("encap" & x & "_Num_3eights") = 1 Then
Range("size_encap" & x).Value = "1.115" & "
X " & "0.535"
ElseIf Range("encap" & x & "_Num_quart") = 2 And
Range("encap" & x & "_Num_half") = 1 Then
Range("size_encap" & x).Value = "1.24" & "
X " & "0.660"
ElseIf Range("encap" & x & "_Num_half") = 1 And
Range("encap" & x & "_Num_3eights") = 2 Then
Range("size_encap" & x).Value = (0.5 + 0.375 +
0.375) + 0.24 & " X " & "0.535"
ElseIf Range("encap" & x & "_Num_half") = 2 And
Range("encap" & x & "_Num_3eights") = 1 Then
Range("size_encap" & x).Value = (0.5 + 0.375 +
0.375) + 0.24 & " X " & "0.535"

Else
End If
End If


'If Range("num_in_encap" & x) = 4 Then
'If Range("encap" & x & "_Num_quart") = 4 Then
'Range("size_encap" & x) = "1.27" & " X " &
"0.433"
'ElseIf Range("encap" & x & "_Num_3eights") = 4
Then
'Range("size_encap" & x) = "1.77" & " X " &
"0.535"
'ElseIf Range("encap" & x & "_Num_half") = 4 Then
'Range("size_encap" & x) = "2.39" & " X " &
"0.660"


'ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 1 And Range("encap" & x &
"_Num_half") = 1 Then
'Range("size_encap" & x).Value = (0.25 + 0.375
+ 0.5) + 0.24 & " X " & "0.660"
'ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_half") = 2 Then
'Range("size_encap" & x).Value = (0.25 + 0.5 +
0.5) + 0.24 & " X " & "0.660"
'ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 2 Then
'Range("size_encap" & x).Value = (0.25 + 0.375
+ 0.375) + 0.24 & " X " & "0.535"
'ElseIf Range("encap" & x & "_Num_quart") = 2 And
Range("encap" & x & "_Num_3eights") = 1 Then
'Range("size_encap" & x).Value = "1.115" & "
X " & "0.535"
'ElseIf Range("encap" & x & "_Num_quart") = 2 And
Range("encap" & x & "_Num_half") = 1 Then
'Range("size_encap" & x).Value = "1.24" & "
X " & "0.660"
'ElseIf Range("encap" & x & "_Num_half") = 1 And
Range("encap" & x & "_Num_3eights") = 2 Then
'Range("size_encap" & x).Value = (0.5 + 0.375
+ 0.375) + 0.24 & " X " & "0.535"

'Else
'End If
'End If


'If Range("num_in_encap" & x) = 5 Then
'If Range("encap" & x & "_Num_quart") = 5 Then
'Range("size_encap" & x) = "0.990" & " X " &
"0.433"
'ElseIf Range("encap" & x & "_Num_3eights") = 5
Then
'Range("size_encap" & x) = "1.365" & " X " &
"0.535"
'ElseIf Range("encap" & x & "_Num_half") = 5 Then
'Range("size_encap" & x) = "1.74" & " X " &
"0.660"


'ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 1 And Range("encap" & x &
"_Num_half") = 1 Then
'Range("size_encap" & x).Value = (0.25 + 0.375
+ 0.5) + 0.24 & " X " & "0.660"
'ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_half") = 2 Then
'Range("size_encap" & x).Value = (0.25 + 0.5 +
0.5) + 0.24 & " X " & "0.660"
'ElseIf Range("encap" & x & "_Num_quart") = 1 And
Range("encap" & x & "_Num_3eights") = 2 Then
'Range("size_encap" & x).Value = (0.25 + 0.375
+ 0.375) + 0.24 & " X " & "0.535"
'ElseIf Range("encap" & x & "_Num_quart") = 2 And
Range("encap" & x & "_Num_3eights") = 1 Then
'Range("size_encap" & x).Value = "1.115" & "
X " & "0.535"
'ElseIf Range("encap" & x & "_Num_quart") = 2 And
Range("encap" & x & "_Num_half") = 1 Then
'Range("size_encap" & x).Value = "1.24" & "
X " & "0.660"
'ElseIf Range("encap" & x & "_Num_half") = 1 And
Range("encap" & x & "_Num_3eights") = 2 Then
'Range("size_encap" & x).Value = (0.5 + 0.375
+ 0.375) + 0.24 & " X " & "0.535"

'Else
'End If
'End If






Else
End If




End If
Next x




'______________________________________________________________________________________________________________________________________

'______________________________________________________________________________________________________________________________________

'______________________________________________________________________________________________________________________________________

'______________________________________________________________________________________________________________________________________

'______________________________________________________________________________________________________________________________________




'call error_msg


If
Application.WorksheetFunction.Sum(Range("encap1_Num_quart:encap1_Num_half"))

Range("num_in_encap1").Value And Range("num_in_encap1") > 0 Then

MsgBox "Error: Number of control lines chosen is greater than the
number selected for encapsulation_1 (sum.cells(C41 - C43) > cell C40)"

ElseIf
Application.WorksheetFunction.Sum(Range("encap2_Num_quart:encap2_Num_half"))

Range("num_in_encap2").Value And Range("num_in_encap2") > 0 Then

MsgBox "Error: Number of control lines chosen is greater than
the number selected for encapsulation_2 (sum.cells(C53 - C55) > cell
C52)"

ElseIf
Application.WorksheetFunction.Sum(Range("encap3_Num_quart:encap3_Num_half"))

Range("num_in_encap3").Value And Range("num_in_encap3") > 0 Then

MsgBox "Error: Number of control lines chosen is greater than
the number selected for encapsulation_3 (sum.cells(C65 - C67) > cell
C64)"
End If


If
Application.WorksheetFunction.Sum(Range("encap1_Num_quart:encap1_Num_half"))
< Range("num_in_encap1").Value And Range("config1") <> "" Then
MsgBox "Enter additional control lines under Type of
encapsulation_1 (cells C41 - C43)"

ElseIf
Application.WorksheetFunction.Sum(Range("encap2_Num_quart:encap2_Num_half"))
< Range("num_in_encap2").Value And Range("config2") <> "" Then
MsgBox "Enter additional control lines under Type of
encapsulation_2 (cells C53 - C55)"

ElseIf
Application.WorksheetFunction.Sum(Range("encap3_Num_quart:encap3_Num_half"))
< Range("num_in_encap3").Value And Range("config3") <> "" Then
MsgBox "Enter additional control lines under Type of
encapsulation_3 (cells C65 - C67)"
End If


If
Application.WorksheetFunction.Sum(Range("non_encap1_Num_quart:non_encap1_Num_half"))

Range("Num_Without_Encapsulation").Value And

Range("Num_Without_Encapsulation") > 0 Then
MsgBox "Error: Number of control lines chosen is greater than the
number selected for non_encapsulation_1 (sum.cells(C32 - C34) > cell
C31)"

End If


'If
Application.WorksheetFunction.Sum(Range("non_encap1_Num_quart:non_encap1_Num_half"))
< Range("Num_Without_Encapsulation").Value Then
' MsgBox "Enter additional control lines under Type of
non_encapsulation_1 (cells C32 - C34)"

'End If


If Range("num_in_encap1") > 3 Then
MsgBox "Function not yet available, Select 3 or less control lines
in encapsulation_1 (cell C40)"

ElseIf Range("num_in_encap2") > 3 Then
MsgBox "Function not yet available, Select 3 or less control lines
in encapsulation_2 (cell C52)"

ElseIf Range("num_in_encap3") > 3 Then
MsgBox "Function not yet available, Select 3 or less control lines
in encapsulation_3 (cell C64)"
End If




'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________
'______________________________________________________________________________________________________________________________________



'end area of code

Application.ScreenUpdating = True


End With
End If


ws_exit:
Application.EnableEvents = True

End Sub

 

[Dave Peterson]

Maybe you could add some lines of code to unprotect the sheet, do the work, then
reprotect the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)

me.unprotect password:="topsecretpassword"

'your code that does all the work

me.protect password:="topsecretpassword"

End Sub

Change the password to what you need.

 

[xl@lf]

That works. Thanks Dave!!!

 

[GS]

xl@lf explained :

Hello,

I have a worksheet containing VBA code with the command
"Worksheet_Change(ByVal Target As Range)".

When I protect the worksheet the command will not run.

Any ideas would be appreciated..

Thank you

When you apply the sheet protection, set the 'Userinterfaceonly:=True'
parameter so code will be able to make changes to locked cells that
otherwise wouldn't be allowed via the UI (ie: cell values, formatting,
formulas,...). This parameter doesn't apply to all kinds of changes,
though, and so Dave's suggestion would need to be used in cases where
your code tries to do stuff like hide/unhide rows/columns or
expand/collapse outlines, and so forth.

It might serve you well to use a separate procedure for applying
protection instead of entering lengthy lines where needed throughout
your code. Here's what I use:

Sub wksProtect(Optional WksName As String)
' Protects specified sheets according to Excel version.
' Assumes Public Const PWRD as String contains the password, even if
there isn't one.
'
' Arguments: WksName [In] Optional. The name of the sheet to be
protected.
' Defaults to ActiveSheet.Name if missing.

If WksName = "" Then WksName = ActiveSheet.name
On Error Resume Next
With Sheets(WksName)
If Val(Application.VERSION) >= 10 Then
'Copy/paste the desired parameters above the commented line.
.Protect Password:=PWRD, DrawingObjects:=False, Contents:=True,
Scenarios:=True, Userinterfaceonly:=True, _
AllowFiltering:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowFormattingCells:=True ', _
AllowDeletingColumns:=True, _
AllowDeletingRows:=True, _
AllowInsertingColumns:=True, _
AllowInsertingHyperlinks:=True, _
AllowInsertingRows:=True, _
AllowUsingPivotTables:=True
Else
.Protect Password:=PWRD, DrawingObjects:=False, Contents:=True,
Scenarios:=True, Userinterfaceonly:=True
End If
' .EnableAutoFilter = True
' .EnableOutlining = True

' .EnableSelection = xlNoRestrictions
' .EnableSelection = xlUnlockedCells
' .EnableSelection = xlNoSelection
End With

End Sub

I comment out any settings I don't use for a particular project, but it
lists all possible settings that Excel currently supports as well as
some sheet-level UI settings that need to be reset after protection is
applied.

HTH