Use VBA to insert password to lock sheets

[Grimm127]

Hello all you experts out there,

I have this code and it works for the most part except for the password. The code itself works but when I go to unlock the sheet it doesn't ask me for the password. So it doesn't seem to add it in. Can you please check it out and see what I am missing? THANK YOU in advance

Private Sub Workbook_Open()
    Dim wshTAB As Variant
    Dim intPassWord As String
    AccountPassWord = "dippy"


         For Each wshTAB In Worksheets(Array("NL_FTM_TRK", "NL_JAX_TRK", "NL_MIA_TRK", "NL_ORL_TRK", "NL_TAM_TRK", "NL_TRAN_OH", "RT_JAX_TRK", "RT_TAM_TRK"))
             wshTAB.Protect Password:=AccountPassWord
             wshTAB.EnableOutlining = True
             wshTAB.Protect Userinterfaceonly:=True
             wshTAB.Protect AllowFiltering:=True
         Next wshTAB


End Sub

 

[Trebor76]

Hi Grimm127,

See how this goes:

Option Explicit
Private Sub Workbook_Open()

    Dim wsMyTAB As Worksheet
    Dim varMyPW As Variant
    
    Application.ScreenUpdating = False
    
    varMyPW = "dippy"
    
    For Each wsMyTAB In Worksheets(Array("NL_FTM_TRK", "NL_JAX_TRK", "NL_MIA_TRK", "NL_ORL_TRK", "NL_TAM_TRK", "NL_TRAN_OH", "RT_JAX_TRK", "RT_TAM_TRK"))
        With wsMyTAB
            .EnableOutlining = True
            .Protect Userinterfaceonly:=True
            .Protect AllowFiltering:=True
            .Protect Password:=varMyPW
        End With
    Next wsMyTAB
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[Grimm127]

SWEET!!!!!! God it looks Great and works perfect!

Now to unlock it would I just do this below?

Option Explicit
Private Sub Workbook_Open()

    Dim wsMyTAB As Worksheet
    Dim varMyPW As Variant
    
    Application.ScreenUpdating = False
    
    varMyPW = "dippy"
    
    For Each wsMyTAB In Worksheets(Array("NL_FTM_TRK", "NL_JAX_TRK", "NL_MIA_TRK", "NL_ORL_TRK", "NL_TAM_TRK", "NL_TRAN_OH", "RT_JAX_TRK", "RT_TAM_TRK"))
        With wsMyTAB
            .UnProtect Password:=varMyPW
        End With
    Next wsMyTAB
    
    Application.ScreenUpdating = True

End Sub

 

[Grimm127]

Having trouble with this. When I run it, it works fine it groups and ungroups. But the Filter doesn't work even if I unlock the cell.
When I close the file and reopen it, it will refuse to open the groups. Saying I have to unlock the sheet.....

 

[Trebor76]

I'm confused as to what you're trying to do

On the one hand you want to lock the sheets in the array when you open the workbook and then you want to unlock them when you open the workbook? A sheet has to be unlocked if it is to be filtered.

 

[Grimm127]

I'm confused as to what you're trying to do

On the one hand you want to lock the sheets in the array when you open the workbook and then you want to unlock them when you open the workbook? A sheet has to be unlocked if it is to be filtered.

Yes, one routine is to lock the sheets. To protect the integrity of the actual data when it's submitted to my Manager's so my roll-up perform as they should. Counterpoint, if there is an issue with one of my formulas, I would need to unlock all of them so I can correct it and then re lock it afterwards.

 

[Trebor76]

I would put the macros in a separate standard module and then just call which you need, i.e. in a standard module have this...

Option Explicit
Public Const varMyPW As Variant = "dippy" 'Password
Private Sub ProtectSheets()

    Dim wsMyTAB As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each wsMyTAB In Worksheets(Array("NL_FTM_TRK", "NL_JAX_TRK", "NL_MIA_TRK", "NL_ORL_TRK", "NL_TAM_TRK", "NL_TRAN_OH", "RT_JAX_TRK", "RT_TAM_TRK"))
        With wsMyTAB
            .EnableOutlining = True
            .Protect Userinterfaceonly:=True
            .Protect AllowFiltering:=True
            .Protect Password:=varMyPW
        End With
    Next wsMyTAB
    
    Application.ScreenUpdating = True

End Sub
Private Sub UnprotectSheets()

    Dim wsMyTAB As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each wsMyTAB In Worksheets(Array("NL_FTM_TRK", "NL_JAX_TRK", "NL_MIA_TRK", "NL_ORL_TRK", "NL_TAM_TRK", "NL_TRAN_OH", "RT_JAX_TRK", "RT_TAM_TRK"))
        With wsMyTAB
            .Unprotect Password:=varMyPW
        End With
    Next wsMyTAB
    
    Application.ScreenUpdating = True

End Sub

...and then call (execute) whichever one you want form wherever you want like so:

Call ProtectSheets
Call UnprotectSheets

Regards,

Robert

 

[Grimm127]

Exactly. Thanks for that. Do you know why when I save the file and close it. Reopen it they the grouping doesn't open any more? It says that the sheet is protected and I will need to un-protect to be able to use the group....

 

[Trebor76]

In your original post the code you had to protect the desired sheets was assigned to the Workbook_Open workbook event. Any code here will run each time the workbook is opened. If you don't want this delete or comment it out.