Change this line:

On Error GoTo ErrHandler:
to
'On Error GoTo ErrHandler:

Note the leading apostrophe. Now when the code runs and an error is
encountered, you'll see the line that blew up.


Tim wrote:

Sorry Dave not sure what/how to comment?

"Dave Peterson" wrote:

What happened when you commented the "on error goto errHandler:" line and ran
your macro?

Tim wrote:

Thanks Dave
I tried changing the line If.Cells.Count Then goto...
But still the same.
I tried looking at the code after I ran the Save_As code, but I get "Project
Locked" Project is Unviewable."

Any thoughts?

Thanks

"Dave Peterson" wrote:

I don't see anything in the Save_As procedure that would harm the event.

But you do have a small bug in your event code.

If .Cells.Count 1 Then Exit Sub

You've already unprotected the sheet and turned off events. If you exit sub,
you're protecting the sheet and events aren't re-enabled.

maybe...
If .Cells.Count 1 Then goto errHandler:
would be better (since you don't do much in that error handler.

My guess is that the password is not correct in your code.

You try to unprotect the worksheet, it causes the error. Your code branches to
the errHandler and tries to reprotect with the incorrect password--then the
explosion!

If you comment out the "on error got errHandler:" line and do a little testing,
you could see the line that really caused the problem.

Tim wrote:

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

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson