Lock Workbook After Date

[nuge725]

Somebody, please help, this is driving me insane! I am trying to set up a workbook that will self-populate the date in H7 (that part I have done), but when that date passes, the workbook will be password locked. In other words, you can change data in today's workbook, tomorrow's, next Tuesday's...but not yesterday's. The file in question is a log for work, in which we document varying work activities and the times they occurred, and each day of the year is a different workbook. This is why I used the =Now() function for the date, to make things simpler. Below is the VBA code that I am using, if that helps any (but it might not help too much, because I'm not an Excel Jedi...yet). Thank you for any help you can give, even if its in the slightest degree.

Private Sub Workbook_Open()
    If Sheet("Activity Sheet").Range("H7").Value <= Today().Value Then
        ActiveWorkbook.Protect Password:="password"
        MsgBox "This workbook is locked, please contact your Team Lead."
    
    End If
End Sub

I also have another Workbook_Open() macro running, which does work, and I keep getting a compile error stating Ambiguous Name Detected: Workbook_Open

 

[VoG]

It would be like this

Private Sub Workbook_Open()
If Sheet("Activity Sheet").Range("H7").Value <= Date Then
    Me.Protect Password:="password"
    MsgBox "This workbook is locked, please contact your Team Lead."
End If
End Sub

You would need to combine this with your other code.

This will only be effective if the user has enabled macros.

 

[nuge725]

VOG,

Thank you for your help! The adjustment you provided to the macro worked. Now I get the message box, but I can still edit cells. How exactly do I ensure that the protection is running? I know it may be a simple question, but I'm at a loss here.

Thanks.

 

[VoG]

Try

Private Sub Workbook_Open()
Dim ws As Worksheet
If Sheet("Activity Sheet").Range("H7").Value <= Date Then
    For Each ws In Me.Worksheets
        ws.Protect password:="password"
    Next ws
    Me.Protect password:="password"
    MsgBox "This workbook is locked, please contact your Team Lead."
End If
End Sub

 

[nuge725]

[SOLVED] Lock Workbook After Date

VoG,

Thanks for all your help. I actually got it working before I saw your latest reply, using the following code:

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if !mso]>******** classid="clsid:38481807-CA0E-42D2-BF39-B33AF135CC4D" id=ieooui></object> <style> st1\:*{behavior:url(#ieooui) } </style> <![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman";} </style> <![endif]-->

Private Sub Workbook_Open()
      If Sheets("SHEET NAME").Range("CELL NUMBER").Value <= Date Then
      ActiveSheet.Protect Password:="password"
      MsgBox "INSERT MESSAGE"
      End If
  End Sub

Thanks Again!

Ryan