Need column to lock after specified date

[resqtk]

Hi, I am a firefighter that has very little knowledge on using VBA, my issue is as follows:

I have a workbook for supply ordering by other members, I want the column that they enter the # Ordered (column "D") to automatically lock after a specified date (R7).

I have the sheet protection on, and use a password, for most of the cells to ensure that the formulas cannot be corrupted.

Column "D" is not locked so that the number of items they need to order can be entered.

I want column "D" to be locked after the date specified in R7 so that it cannot be adjusted. This will ensure that items cannot be adjusted to falsely decrease the amount spent.

I know that there are some modules that are probably not used; I have changed the original file since it was first created by another member. Therefore some of it might not be relevant to the current version.

Thanks

2013-2014 Station 1 --- TEST ---.xlsm

[Mumps1]

Hi rsqtk. I had a look at your file and noticed that many cells have been merged. Merged cells most often create problems for Excel. You want to lock column D which contains merged cells. If you have a look at the attachment, you will notice that I have unmerged the cells in column D from row 2 to row 189, since this is the range you want to lock. As well, I have unlocked the cells in the same range in column D to allow input once the sheets are protected. The macro that locks column D based on the date in R7 is in the 'ThisWorkbook' code module. Try out the attached file and see if it works for you.

[resqtk]

Thanks, the merged cell issue makes sense.

When I tried to open the file and it came up with a

Run-Time Error '1004':
Method 'Active' of object '_Worksheet' Failed.

[Mumps1]

When I open a copy of the file on my computer I don't get any error. When I open the attachment I only get the error when I click the 'Enable Editing' button because 'Protected View' is turned on in Excel. If you turn off 'Protected View' on your computer, you shouldn't get the error message but by doing so, you could expose your computer to potentially unsafe files. Open the attachment in my previous post. When you get the error message click 'End'. Save the file on your computer and then close it. Re-open it and see if the error message still appears. If this doesn't work, try starting with your original file and make the changes such as unmerging the cells in column D and unlocking them. Then copy and paste the macro below into the 'ThisWorkbook' code module. Save the file and then re-open it. You may want to 'Save As' and change the file name so you don't overwrite your original file. Please let me know how it works out.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim rng As Range
    For Each ws In Sheets
        If ws.Name <> "Title Sheet" And ws.Name <> "Usage" Then
            ws.Activate
            ActiveSheet.unprotect Password:="password"
            If Date < Range("R7").Value Then
                For Each rng In Range("D1:D189")
                    rng.Locked = True
                Next rng
            End If
            ActiveSheet.Protect Password:="password"
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

[Mumps1]

Hi rsqtk. Sorry. I wrote my response before I read your last one. Could you post a copy of the file you're working with? This way we're both on the same page.

[resqtk]

Mumps1 - I have gone back to the original file and made the changes un-merging column D, then I copied and pasted your code into the 'ThisWorkbook' module as you had it. It kinda worked.

It left the 2nd page (Oct 22) column D unlocked since it is not the 24th yet, but it locked all of the other sheets column D. Then when I changed the date in R7 on the 2nd page to 10/08/13 saved, exited then re-opened it was still unlocked. Also one thing I notice is that when I re-open the file it opens on the second to last page, can it not re-open on the last page it was on?

[resqtk]

Here is the file with the updates that I made with your code. If you look Oct 22 has the dae set prior to today and it is unlocked, while the rest of the sheets are locked...

2013-2014 Station 1 --- TEST ---.xlsm

[Mumps1]

Change this line:
If

 If Date < Range("R7").Value Then

to:

 If Date >= Range("R7").Value Then

[resqtk]

Ok, That made a difference...

Now column D in all sheets are locked, not just Oct 22nd with the past date as a test...

[Mumps1]

In the attached file, the Oct 22, Apr 8 and Sep 23 sheets column D is locked because the date has passed. In all the other sheets column D is unlocked.

[resqtk]

Awesome, looks great. Now how to I unlock those pages? I have tried to change the date back to future dates, save then reopen but those 3 pages are still locked....

Though I have a thought, what if I go into the format section and select unlock??? Hold on be right back...........

[resqtk]

That fixed it, I'm getting better with this.

Almost there....

Lets go back to my 3rd post, "one thing I notice is that when I re-open the file it opens on the second to last page, can it not re-open on the last page it was on?" I have a feeling that this is happening by the save point in the code checking all the dates in R7 on all pages. But it would be helpfull if it would reopen on the last page that was manually updated.

[Mumps1]

I've modified the macro so that if you change the date back to future dates, column D will be unlocked. Try it out and let me know how it works.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim rng As Range
    For Each ws In Sheets
        If ws.Name <> "Title Sheet" And ws.Name <> "Usage" Then
            ws.Activate
            ActiveSheet.unprotect Password:="password"
            If Date >= Range("R7").Value Then
                For Each rng In Range("D1:D189")
                    rng.Locked = True
                Next rng
            ElseIf Date < Range("R7").Value Then
                For Each rng In Range("D1:D189")
                    rng.Locked = False
                Next rng
            End If
            ActiveSheet.Protect Password:="password"
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

You may be right about why it doesn't re-open to the last page it was on. I'm not sure how to fix that problem.

[resqtk]

Well, that made it alot easier than going back through each page and manually unlocking them.

Thank you for all of your help, I very much appreciate it.

[Mumps1]

It was my pleasure. It took a while but we finally got there.

[resqtk]

Ok I was not able to figure out how to get it to open to the last sheet it was on but I did figure out how to open to a specifi sheet. So I have it open up on the title screen each time, making it where the user will have to select a page to enter their order.

Again thanks for all of your help.

[Mumps1]

I'm glad it worked out.