need help with password protection and macro

G

Guest

to the following syntax what can be added so that I can put a password (2468)
on the protection of the sheet. Right now, this sheet automatically protects
itself and I want to add a password. Can a macro automatically enter a
password (2468) upon its protection of the sheet?

Option Explicit

Private Sub worksheet_change(ByVal target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = target.Value
Application.Undo
oldVal = target.Value
target.Value = newVal
If target.Column = 11 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If

exitHandler:
Application.EnableEvents = True

If target.Cells.Count > 1 Then Exit Sub
If target.Row < 10 Or target.Row > 13 Then Exit Sub
Application.EnableEvents = False
If target.Column = 2 Then
If IsNumeric(target) = False Then
If Len(target) > 0 Then
target.Offset(0, 4) = ""
End If
End If
End If
Application.EnableEvents = True
End Sub

Thank You
 
G

Guest

I am sorry,
I posted wrong syntax it should be:

Option Explicit

Private Sub Workbook_Open()
ThisWorkbook.Sheets("Patrol Log") _
.Protect DrawingObjects:=True, _
contents:=True, Scenarios:=True, _
UserInterfaceOnly:=True
End Sub
 
K

Ken Wright

See code below for example syntax

Public Sub ProtectAllSheets()
'Courtesy of J E McGimpsey
'Space allowed for insertion of a password
'Code lists every sheet with it's protection status
Application.ScreenUpdating = False
Const PWORD As String = ""
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
wkSht.Protect Password:=PWORD
statStr = statStr & ": Protected"
End With
Next wkSht
MsgBox Mid(statStr, 2)
Application.ScreenUpdating = True
End Sub


Public Sub UnprotectAllSheets()
'Courtesy of J E McGimpsey
'Space allowed for insertion of a password
'Code lists every sheet with it's protection status
Application.ScreenUpdating = False
Const PWORD As String = ""
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
wkSht.Unprotect Password:=PWORD
statStr = statStr & ": Unprotected"
End With
Next wkSht
MsgBox Mid(statStr, 2)
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top