I am having problems with the following macro. The problem occurs after I run
the Save_As macro. When I re-open the workbook and try to enter data in the
Range €œAR71:BX97€�. I get an error message €œRun-time error €˜1004 Method
€˜Protect of object €˜_Worksheet Failed.€�
My knowledge of VBA is very limited. Members of this group helped me write
these two macros some time ago.
Is there any way to have the Work_Sheet Change to work after I run the
Save_As?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myUpperRng As Range
Dim myProperRng As Range
Dim myDateTimeRng As Range

Set myUpperRng =
Me.Range("$AU$2,$I$4,$BP$5,$AP$7,$F$7,$AM$13,$J$40 ,$BP$41")
Set myProperRng =
Me.Range("$AY$4,$H$5,$H$41,$AF$4,$AO$5,$BM$6,$BJ$2 9,$G$12,$AC$40,$AW$40,$AO$4")
Set myDateTimeRng = Me.Range("AR71:BX97")

On Error GoTo ErrHandler:
Application.EnableEvents = False
Me.Unprotect Password:="Password"
With Target
If .Cells.Count 1 Then Exit Sub
If Not (Intersect(myUpperRng, .Cells) Is Nothing) Then
.Value = StrConv(.Value, vbUpperCase)
ElseIf Not (Intersect(myProperRng, .Cells) Is Nothing) Then
.Value = StrConv(.Value, vbProperCase)
ElseIf Not (Intersect(myDateTimeRng, .Cells) Is Nothing) Then
If IsEmpty(.Value) Then
.Offset(0, -43).ClearContents
Else
With .Offset(0, -43)
.NumberFormat = "dd-mmm-yy hh:mm"
.Value = Now
End With
End If
End If
End With

ErrHandler:
Me.Protect Password:="Password"
Application.EnableEvents = True

End Sub



Sub Save_As()
Dim FName1 As String, FName2 As String
Dim FName3 As String, Fullname As String
FName1 = Range("AU2").Value & "-"
FName2 = Range("I4").Value & ", "
FName3 = Range("AF4").Value
Fullname = FName1 & FName2 & FName3
Application.DisplayAlerts = False
ChDrive "C"
ChDir "C:\Tim's Stuff"
With ActiveSheet
If .Range("BJ35").Value = "No" Then
Worksheets(Array("Sheet 4", " Sheet 5", " Sheet 6")).Delete
ElseIf .Range("BJ35").Value = "Yes" Then
Worksheets(Array("Sheet 3")).Delete
End If
If .Range("N36").Value = "Adult" Then
Worksheets(Array("Sheet 7", " Sheet 8", " Sheet 9", " Sheet 10",
" Sheet 11", " Sheet 13")).Delete
ElseIf .Range("N36").Value = "Youth" Then
Worksheets(Array("Sheet 14", " Sheet 15", " Sheet 16", " Sheet
17")).Delete
End If
Dim Result As Long
Result = MsgBox("Do you want to delete more sheets?", vbYesNo)
If Result = vbNo Then
Worksheets(Array("Sheet 18", " Sheet 19")).Delete
End If

End With