Hi
I have a routine that protects the worksheet when it is actioned.
Unfortunately I have been unable to include a password in this routine - so
the sheet is really unprotected and therefore open to alteration by the user.

The routine is:
'This is necessary to avoid having to unprotect
'and protect the sheet every time the macro fires
Private Sub Worksheet_Activate()
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Any help appreciated.

Hi,

Try this

Private Sub Worksheet_Activate()
ActiveSheet.Protect Password:="mypass"
End Sub

Mike

"johnsail" wrote:

Hi
I have a routine that protects the worksheet when it is actioned.
Unfortunately I have been unable to include a password in this routine - so
the sheet is really unprotected and therefore open to alteration by the user.

The routine is:
'This is necessary to avoid having to unprotect
'and protect the sheet every time the macro fires
Private Sub Worksheet_Activate()
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Any help appreciated.

On Apr 12, 2:10*pm, Mike H wrote:
Hi,

Try this

Private Sub Worksheet_Activate()
ActiveSheet.Protect Password:="mypass"
End Sub

Mike

"johnsail" wrote:
Hi
I have a routine that protects the worksheet when it is actioned.
Unfortunately I have been unable to include a password in this routine - so
the sheet is really unprotected and therefore open to alteration by the user.

The routine is:
'This is necessary to avoid having to unprotect
'and protect the sheet every time the macro fires
Private Sub Worksheet_Activate()
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Any help appreciated.

I'd echo Mike H, but be sure to check the Excel VBA help and search
for the Worksheet.Protect method which lists all of the parameters.

Alex

Hi Mike

Thought I'd replied to this - but must have pressed the wrong button.

The change makes no difference.

If the sheet is saved as protected with a password then the rest of the code
falls over.

if the start bit is replaced with code that unprotects at start of routine
and protects at the end then the code falls over when trying to lock/unlock
cells.

Rest of code shown below:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim OldVal, CaseE As Boolean
If Target.Cells.Count 1 Then
Exit Sub
End If
On Error GoTo ErrHandler:
If Not Application.Intersect(Me.Range("C7:D34"), Target) Is Nothing Then
If IsNumeric(Target.Value) = False Then
Application.EnableEvents = False
'Target.Value = StrConv(Target.Text, vbLowerCase)
'Target.Value = StrConv(Target.Text, vbUpperCase)
Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If
ErrHandler:
Application.EnableEvents = True

If Target.Column = 4 Then
OldVal = Target.Offset(0, 8).Value
CaseE = IsEmpty(Target)
If Target = "Mileage" Then
Target.Offset(0, 1).Locked = False
Target.Offset(0, 1).Select
Else
Target.Offset(0, 6).Locked = False
Target.Offset(0, 6).Select
End If
If OldVal = "Mileage" And Target < "Mileage" Then
With Target.Offset(0, 1)
.ClearContents
.Locked = True
End With
With Target.Offset(0, 6)
.ClearContents
.Select
End With
End If
If Target < OldVal And Target = "Mileage" Then
With Target.Offset(0, 6)
.Formula = Target.Offset(0, 7).Formula
.Locked = True
End With
Target.Offset(0, 1).Select
End If
Target.Offset(0, 8) = Target.Value
If CaseE Then
With Target.Offset(0, 1)
.ClearContents
.Locked = True
End With
With Target.Offset(0, 6)
.ClearContents
.Formula = Target.Offset(0, 7).Formula
.Locked = True
End With
Target.Offset(0, 0).Select
End If
End If
End Sub

"Mike H" wrote:

Hi,

Try this

Private Sub Worksheet_Activate()
ActiveSheet.Protect Password:="mypass"
End Sub

Mike

"johnsail" wrote:

Hi
I have a routine that protects the worksheet when it is actioned.
Unfortunately I have been unable to include a password in this routine - so
the sheet is really unprotected and therefore open to alteration by the user.

The routine is:
'This is necessary to avoid having to unprotect
'and protect the sheet every time the macro fires
Private Sub Worksheet_Activate()
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Any help appreciated.