Lock a worksheet after certain date is passed

[mr names]

Hi there

I'm trying to find a macro that I can place into a worksheet to lock it for editing after a certain date passes. I could do with them being able to view it still. I already have the sheet protected as I didn't want people the edit the layout so if there is another way other than using the 'protect sheet' method, that would be great!

The date will be driven from cell $B$3 but I would like it to be that date plus 5 days for example?

Could also do with the message that comes up being tailored in some way to have the contact details of the person that is required to unlock it?

Hope this is enough information...

Thanks

 

[JamesW]

Hi there,

Maybe this will get you started?

Private Sub Workbook_Open()
    If Sheets(1).Cells(1, 1).Value >= Date And Sheets(1).Cells(1, 1).Value <= Date + 5 Then
        ActiveWorkbook.Protect Password:="password"
        MsgBox "This workbook is locked, please contact xxx@xxx.com"
    Else
        'MsgBox "unlocked"
    End If
End Sub

Change the sheets(1).cells(1,1) to whatever sheet and cell your date is in.

 

[mr names]

Hi and thanks!

Just tried it and seem to be getting an application error.

I did change it to only apply to one worksheet (sheet7) so not sure if that has made the code work incorrectly?

Hope you can help!

I'm new to excel so a bit of a novice

 

[JamesW]

What is sheet7 called? Is it the 7th sheet in your workbook? Sheets(7) will apply to whatever excel thinks is your 7th sheet - if you add 7 sheets, delete the 7th and add a new one, the new one will be sheet 8.

Try: Sheets("Sheet7") instead - change Sheet7 to whatever your sheet is called.

 

[mr names]

hmmm - just tried that and it comes up with runtime error 13; type mismatch. This is the code that I have so far (as I said, I'm a novice so if it's bad - I apologise!). Sheet 7 is named "Gate 2"...but i've tried this and the same error occurs:



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Sheets(7).Cells("B3").Value >= Date And Sheets(7).Cells("B3").Value <= Date + 5 Then
ActiveWorkbook.Protect Password:="password"
MsgBox "This workbook is locked, please contact xxx@xxx.com"
Else
'MsgBox "unlocked"
End If
End Sub

 

[JamesW]

Try:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Sheets("Gate 2").Range("B3").Value >= Date And Sheets("Gate 2").Range("B3").Value <= Date + 5 Then
        ActiveWorkbook.Protect Password:="password"
        MsgBox "This workbook is locked, please contact xxx@xxx.com"
    Else
        'MsgBox "unlocked"
    End If
End Sub

 

[mr names]

Thats strange - not getting an error anymore but the code doesn't seem to be doing anything?

It's not locking or displaying a message.

 

[JamesW]

Hi,

Because the code is in "Worksheet_SelectionChange" it will only work in the sheet you have put the code in, that's why I suggested Workbook_Open.

 

[mr names]

I see....But the code wont protect the sheet that it is assigned too either?

I have put the date in B3 in the past (ie 10 days ago) so therefore it should see this as being more than the 5 days and lock the sheet with a message box shouldn't it. As it is at the moment, the sheet is still fully editable and doesn't give a message box?

As I said, I'm a newbie so sorry if it's me thats causing this!

 

[mr names]

ANyone any ideas about this?

Any suggestions welcome!