Sorry, I also noticed that the last part of the Save_As code got cut off in
my original post. Not sure if it makes a difference?

End With
ActiveWorkbook.SaveAs Fullname, _
FileFormat:=xlNormal, _
CreateBackup:=False, _
Accessmode:=xlShared
MsgBox "Saved to " & CurDir & " - " & Fullname

End Sub

"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