Lock selected range except for current week

[michal2287]

Hi all,

I would like to ask if somebody could help me with this:

In a row E2 - BD2 I have Week title (Week1 - Week 52).

Today is still a week 25 therefore area (AC3 - AC11) should be editable and all weeks before should be locked (AB - E).
Next week when I open excel all weeks including 25th should be locked and the week 26 (AD3 - AD11) should be open for editing.

I was looking for the solution, I saw some treads but nothing worked for me.

I hope I explained clearly what I need. Thank you all for the help!


Michal

[Paul_Hossler]

Put this is the ThisWorkbook module and see it it works for you




Option Explicit
Private Sub Workbook_Open()
Dim iWeekNum As Long, iColNum As Long


'1 Week begins on Sunday. Weekdays are numbered 1 through 7.
'2 Week begins on Monday. Weekdays are numbered 1 through 7.
iWeekNum = Application.WorksheetFunction.WeekNum(Now, 1)
iColNum = iWeekNum + 4

With Worksheets("Sheet1")
.Unprotect Password:="password"
.Cells.Locked = True
.Columns(iColNum).Locked = False
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End With
End Sub

[SamT]

Range with Table VBA? (http://www.vbaexpress.com/forum/showthread.php?56412-Range-with-Table-VBA) has a neat way to determine columns.

Since you only have to worry about the week # in that example:

WkNum = CStr(DateDiff("w", CDate(Format(Date, "1/1/yyyy")), Date, vbSunday, vbFirstJan1))



You can fine tune DateDiff with the FirstDayOfWeek and FirstWeekOfYear parameters ie, vbMonday and vbFirstFullWeek

How it works:
Date returns today's date
Format(Date, "1/1/yyyy") returns the String "1/1/2016" at least it will for the rest of this year.
CDate(*) Converts Format's date string to a Date Type
DateDiff("w", . . . ) returns the difference in weeks ("w") between two dates
CStr(*) converts the numerical return of DateDiff into a String Type
*VBA usually does the Cstr and CDate conversions automatically. Included here for clarity.

With that,you can plug the String Variable WkNum into the code in the above link to determine which column your Range-To-Unlock is in

[michal2287]

Put this is the ThisWorkbook module and see it it works for you




Option Explicit
Private Sub Workbook_Open()
Dim iWeekNum As Long, iColNum As Long


'1 Week begins on Sunday. Weekdays are numbered 1 through 7.
'2 Week begins on Monday. Weekdays are numbered 1 through 7.
iWeekNum = Application.WorksheetFunction.WeekNum(Now, 1)
iColNum = iWeekNum + 4

With Worksheets("Sheet1")
.Unprotect Password:="password"
.Cells.Locked = True
.Columns(iColNum).Locked = False
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End With
End Sub



Thank you, it works but I will play with it a little since it allowed me to edit only the week 26 which is the next one.

I have one more question, is it possible to add an exception, and unlock cells B28 - B33 in the document?

Also how can I apply this on whole document, not only for one sheet?

Thank you both for your response, I really appreciate it!

Michal

[Paul_Hossler]

Try this then



Option Explicit

Private Sub Workbook_Open()
Dim iWeekNum As Long, iColNum As Long
Dim ws As Worksheet

'1 Week begins on Sunday. Weekdays are numbered 1 through 7.
'2 Week begins on Monday. Weekdays are numbered 1 through 7.
iWeekNum = Application.WorksheetFunction.WeekNum(Now, 1)
iColNum = iWeekNum + 4

For Each ws In ActiveWorkbook.Worksheets
With ws
If .Range("E2").Value = "Week01" Then
.Unprotect Password:="password"
.Cells.Locked = False
.Columns(1).Resize(, iColNum - 1).Locked = True
.Range("B28:B33").Locked = False
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End If
End With
Next
End Sub

[michal2287]

Try this then



Option Explicit

Private Sub Workbook_Open()
Dim iWeekNum As Long, iColNum As Long
Dim ws As Worksheet

'1 Week begins on Sunday. Weekdays are numbered 1 through 7.
'2 Week begins on Monday. Weekdays are numbered 1 through 7.
iWeekNum = Application.WorksheetFunction.WeekNum(Now, 1)
iColNum = iWeekNum + 4

For Each ws In ActiveWorkbook.Worksheets
With ws
If .Range("E2").Value = "Week01" Then
.Unprotect Password:="password"
.Cells.Locked = False
.Columns(1).Resize(, iColNum - 1).Locked = True
.Range("B28:B33").Locked = False
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End If
End With
Next
End Sub



Thank you, Paul! It works more or less. It blocks all sheets, which is good, but it does not lock all the cells I wanted. It does not lock all the upcoming weeks till the rest of the year. And again it calculates that today is a week 27 even though it is not therefore my dates are not correct. But I think it is not a big deal, I will try to edit it :)

Thank you once again!

Michal

[snb]

Or use:


Private Sub Workbook_Open()
Sheet1.ScrollArea = [sheet1!C3:C11].Offset(, 4 + Application.WeekNum(Date, 21)).Address
End Sub

[michal2287]

Or use:


Private Sub Workbook_Open()
Sheet1.ScrollArea = [sheet1!C3:C11].Offset(, 4 + Application.WeekNum(Date, 21)).Address
End Sub

Thank you, but it locks everything except for week 28. And today is still week 25 :(

[snb]

How much is 28 - 25 ??

The information you provided (starting in Column E) isn't correct.

Today it's still week 25 (in Europe and all other countries that conform to the ISO criteria: see http://www.snb-vba.eu/VBA_ISO_weeknummer_en.html).
Analyse the code and adapt it to the new situation you want it to apply to.

[Paul_Hossler]

How are you calculating week number? Today is June 26, a Sunday



'1 Week begins on Sunday. Weekdays are numbered 1 through 7.
'2 Week begins on Monday. Weekdays are numbered 1 through 7.


=WeekNum(Now(),X) is week 27 if X = 1, or week 26 if X = 2


However ....

https://msdn.microsoft.com/en-us/library/office/ff836525(v=office.15).aspx



The WEEKNUM function considers the week containing January 1 to be the first week of the year. However, there is a European standard that defines the first week as the one with the majority of days (four or more) falling in the new year. This means that for years in which there are three days or less in the first week of January, the WEEKNUM function returns week numbers that are incorrect according to the European standard.


so this might be the reason for the difference in week numbers



Today is still a week 25 therefore area (AC3 - AC11) should be editable and all weeks before should be locked (AB - E).

You only want the CURRENT WEEK and B28:B33 unlocked?

You want weeks 1 to 52 (except CURRENT WEEK) locked?


So using the European standard and X = 1, June 26, 2016 is week number 26, and X = 2 it is week number 25

Therefore, for June 26, 2016 a Sunday, using Euopean standard, only week 25 column and B28:B30 are unlocked




Option Explicit
Private Sub Workbook_Open()
Dim iWeekNum As Long, iColNum As Long
Dim ws As Worksheet


'1 Week begins on Sunday. Weekdays are numbered 1 through 7.
'2 Week begins on Monday. Weekdays are numbered 1 through 7.
iWeekNum = Application.WorksheetFunction.WeekNum(Now, 2)


'https://msdn.microsoft.com/en-us/library/office/ff836525(v=office.15).aspx
'The WEEKNUM function considers the week containing January 1 to be the first week of the year.
'However, there is a European standard that defines the first week as the one with the majority
'of days (four or more) falling in the new year. This means that for years in which there are
'three days or less in the first week of January, the WEEKNUM function returns week numbers that
'are incorrect according to the European standard.

If Weekday(DateSerial(Year(Now), 1, 1)) > vbWednesday Then
iWeekNum = iWeekNum - 1
End If

iColNum = iWeekNum + 4


For Each ws In ActiveWorkbook.Worksheets
With ws
If .Range("E2").Value = "Week01" Then
.Unprotect Password:="password"
.Cells.Locked = True
.Columns(iColNum).Locked = False
.Range("B28:B33").Locked = False
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End If
End With
Next
End Sub

[snb]

@PH

ISO is an international standard, not a European standard.

The first week of a year is the week in which the fourth of january falls.
That week always starts on monday.
That's the ISO standard.

[Paul_Hossler]

@snb

Didn't know that. I was only going by what MS online help said

[michal2287]

Amazing, thank you very much, guys!