VBA event based password for one worksheet

Giggs1991

Board Regular
Joined
Mar 17, 2019
Messages
50
Hi All,

I wanted some help regarding VBA for worksheet passwords.


I have a worksheet named "Code" in my workbook. Cell A1 in this worksheet has the value COSPASS.
I have another worksheet named "Logs" which is locked using the password COSPASS mentioned above.


I wanted an event based VBA code that will unlock worksheet named "Logs" using the password "COSPASS" everytime i change any value in the workbook and lock itself automatically.
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
The "Logs" file was created to capture logs/time stamps of any changes happening to this shared file. The issue is that the "Logs' file is unprotected. I would like for this password to unlock the "Logs" worksheet when a change is made, capture the logs and lock it back each time a change is made anywhere in the workbook.
 
Upvote 0
It sounds like putting this in the ThisWorkbook code module would be what you want
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim LogSheet As Worksheet
    Set LogSheet = Me.Worksheets("Logs")
    If Sh.Name <> LogSheet.Name Then
        With LogSheet
            Application.EnableEvents = False
            .Unprotect "password"
            With .Range("A:A")
                With .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    .Value = Now
                    .Offset(0, 1).Value = Target.Address(, , , True)
                End With
            End With
            .Protect "password"
            Application.EnableEvents = True
        End With
    End If
End Sub
 
Upvote 0
This code works very well .Thank you!!!


I just wanted to improve the password management feature for this workbook. The password is hardcoded as "password " (as per my initial request).


I wanted the password to be a randomly generated one. I tried doing this myself using the "=randbetween" formula in a new worksheet. However, every time i opened the file, a new password would get generated and it would not be able to unlock the sheet. would you know a work around this?
 
Last edited:
Upvote 0
You could put this in the ThisWorkbook code module.
Note that the current password protecting the Logs sheet is in Logs!G1, which is visible (so not very strong protection)
If you un-comment out the line in Property Let LogPassword, that column will be hidden. And it will become extremely difficult for an admin. to work with the book.
SO, if the column is hidden, saving the workbook changes the password to no password, giving an admin a fighting chance to work with the book.


Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim LogSheet As Worksheet
    Set LogSheet = Me.Worksheets("Logs")
    If Sh.Name <> LogSheet.Name Then
        With PWCell.Parent
            Application.EnableEvents = False
            .Unprotect Me.LogPassword
            With .Range("A:A")
                With .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    .Value = Now
                    .Offset(0, 1).Value = Target.Address(, , , True)
                End With
            End With
            Me.LogPassword(True) = "random"
            Application.EnableEvents = True
        End With
    End If
End Sub

Private Function PWCell() As Range
    Set PWCell = Sheet3.Range("G1")
End Function

Property Get LogPassword(Optional MakeRandom As Boolean) As String
    LogPassword = PWCell.Value
End Property

Property Let LogPassword(Optional MakeRandom As Boolean, inVal As String)
    If MakeRandom Then
        inVal = "pw" & WorksheetFunction.RandBetween(100, 999)
    End If
    With PWCell
        .Parent.Unprotect Me.LogPassword
        '.EntireColumn.Hidden = True
        .Value = inVal
        .Parent.Protect inVal
    End With
End Property

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If PWCell.EntireColumn.Hidden Then
        Me.LogPassword = vbNullString
    End If
End Sub
 
Upvote 0
Thank you. The code works well. The only issue is that the logs go into the worksheet "sheet3" instead of the "Logs" worksheet. Is there a way to fix that?
 
Upvote 0

Forum statistics

Threads
1,214,520
Messages
6,120,017
Members
448,937
Latest member
BeerMan23

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top