unlock / hide sheets with password

[Cablek]

I currently have a workbook that when Costing Sheet or Costing Work Sheet sheets are clicked on it requires a password... the problem is that once the user enters this password then clicks on the next sheet he then needs to enter the password again when he goes back...

Is there anyway to have it so once the password have been entered it unlocks the 2 sheets for the duration that the file is open?

current code for each sheet is

Private Sub Worksheet_Activate()
Dim strPassword As String
On Error Resume Next
Me.Protect Password:="Purchaser"
Me.Columns.Hidden = True
strPassword = InputBox("Enter password to access Costing sheet")
If strPassword = "" Then
ActiveSheet.Visible = False
Worksheets("Menu").Select
Exit Sub
ElseIf strPassword <> "Purchaser" Then
MsgBox "Password Incorrect "
ActiveSheet.Visible = False
Worksheets("Costing sheet").Select
Exit Sub
Else
Me.Unprotect Password:="Purchaser"
Me.Columns.Hidden = False
End If
Range("a1").Select
On Error GoTo 0
End Sub
Private Sub Worksheet_Deactivate()
On Error Resume Next
Me.Columns.Hidden = True
On Error GoTo 0
End Sub

same for the 2nd sheet but different name

 

[Cablek]

does anybody have an idea if this is possible?

 

[NoSparks]

Perhaps the use of a public Boolean variable set to TRUE the first time the sheet is activated
and its state being checked at the beginning of sub.

Option Explicit
Dim alreadyused As Boolean

Private Sub Worksheet_Activate()
Dim strPassword As String

If alreadyused Then
    Me.Unprotect Password:="Purchaser"
    Me.Columns.Hidden = False
    Exit Sub
End If

On Error Resume Next
Me.Protect Password:="Purchaser"
Me.Columns.Hidden = True

strPassword = InputBox("Enter password to access Costing sheet")

If strPassword = "" Then
    ActiveSheet.Visible = False
    Worksheets("Menu").Select
    Exit Sub
ElseIf strPassword <> "Purchaser" Then
    MsgBox "Password Incorrect "
    ActiveSheet.Visible = False
    Worksheets("Costing sheet").Select
    Exit Sub
Else
    Me.Unprotect Password:="Purchaser"
    Me.Columns.Hidden = False
    alreadyused = True
End If

Range("a1").Select
On Error GoTo 0
End Sub

 

[Cablek]

FANTASTIC>>>>>>>> thanks NoSparks worked like a charm...

 

[NoSparks]

You're welcome, glad I could help.