Changing the code from sheet to whole workbook

[michal2287]

Hi all,

I am using this code, that will lock some cells after a month based on current month:



Private Sub Workbook_Open()
Dim colst, colend As Integer 'starting column of previous month and end column of previous month
Dim wknost As Integer 'first week of previous month
Dim wknoend As Integer 'last week of previous month. If week belongs also to current month, week earlier to be taken




Sheets("Sheet").Unprotect Password:="test"




wknost = DatePart("ww", DateSerial(Year(Now), Month(Now) - 1, 1), vbMonday, vbFirstFourDays)
wknoend = DatePart("ww", DateSerial(Year(Now), Month(Now), 1) - 1, vbMonday, vbFirstFourDays)




If wknoend = DatePart("ww", DateSerial(Year(Now), Month(Now), 1), vbMonday, vbFirstFourDays) Then
wknoend = wknoend - 1
End If




With Sheets("Sheet").Range("2:2")
Set c = .Find(What:="Week " & wknost, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not c Is Nothing Then
colst = c.Column
End If
End With
With Sheets("Sheet").Range("2:2")
Set d = .Find(What:="Week " & wknoend, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not d Is Nothing Then
colend = d.Column
End If
End With


With Sheets("Sheet").Range(Cells(1, colst).EntireColumn, Cells(1, colend).EntireColumn)
.Locked = True
.FormulaHidden = True

End With


Sheets("Sheet").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test"






End Sub


Since I am not good with VBA, could anybody change this code into a code that I could insert into This workbook and make it work for whole document? Except for one sheet? The condition could be " If .Range("E2").Value = "Week 1" Then"

Thank you very much for your help!

Best,

Michal

[SamT]

See if this works for you

Option Explicit

Private Sub Workbook_Open()
Dim colst As Long, colend As Long 'starting column of previous month and end column of previous month
Dim wknost As Integer 'first week of previous month
Dim wknoend As Integer 'last week of previous month. If week belongs also to current month, week earlier to be taken
Dim sht As Worksheet
Dim c As Range, d As Range

wknost = DatePart("ww", DateSerial(Year(Now), Month(Now) - 1, 1), vbMonday, vbFirstFourDays)
wknoend = DatePart("ww", DateSerial(Year(Now), Month(Now), 1) - 1, vbMonday, vbFirstFourDays)

If wknoend = DatePart("ww", DateSerial(Year(Now), Month(Now), 1), vbMonday, vbFirstFourDays) Then _
wknoend = wknoend - 1

For Each sht In Worksheets
With sht
.Unprotect Password:="test"

With .Range("2:2")
Set c = .Find(What:="Week " & wknost, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not c Is Nothing Then colst = c.Column

Set d = .Find(What:="Week " & wknoend, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not d Is Nothing Then colend = d.Column
End With 'Range 2:2

With .Range(Cells(1, colst).EntireColumn, Cells(1, colend).EntireColumn)
.Locked = True
.FormulaHidden = True
End With

.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test"

End With 'Sht
Next sht
End Sub

[michal2287]

Thank you, but unfortunatelly it says Run Time Error 1004 :/

[SamT]

Where? on which line?

[michal2287]

Where? on which line?

It doesn't say / show. It says only:

"Run-time error '1004':

Application-defined or object-defined error"

[SamT]

In the VBA editor, put the cursor inside the code and press F8 until the error appears.

BTW, that code must be in the ThisWorkbook code page.

[michal2287]

I have a mac, so If I do it properly (cmd + shift + i) then it marks: "Private Sub Workbook_Open()"

yes, I pasted it into ThisWorkbook :)

[SamT]

then it marks: "Private Sub Workbook_Open()"
You said, "it marks." Do you mean it raises the Error at that time?

Every line will be highlighted when that line is the next to be run. Keep pressing until the Error is Raised.

BTW, I have a doctor's appointment now and won't be back for some time.

[michal2287]

You said, "it marks." Do you mean it raises the Error at that time?

Every line will be highlighted when that line is the next to be run. Keep pressing until the Error is Raised.

BTW, I have a doctor's appointment now and won't be back for some time.

Ah, gotcha. It stops here:
With .Range(Cells(1, colst).EntireColumn, Cells(1, colend).EntireColumn)

And sure, no problem! I will check the forum later, thank you in advance! :)

[SamT]

With .Range(Cells(1, colst), Cells(Rows.Count, colend)) 'Rows.Count is Entire Column

Better

With .Range(Cells(1, colst), Cells(Rows.Count, colend).End(xlUp)) 'May miss some if Column(colend) is shorter then others

Best, IMO

With Intersect(.UsedRange, .Range(Cells(1, colst), Cells(Rows.Count, colend))) 'Entire column in UsedRange

[michal2287]

With .Range(Cells(1, colst), Cells(Rows.Count, colend)) 'Rows.Count is Entire Column

Better

With .Range(Cells(1, colst), Cells(Rows.Count, colend).End(xlUp)) 'May miss some if Column(colend) is shorter then others

Best, IMO

With Intersect(.UsedRange, .Range(Cells(1, colst), Cells(Rows.Count, colend))) 'Entire column in UsedRange

I tried all of them but neither worked. Still the same error :/

[SamT]

I added some troubleshooting msgboxes, shortened the code a bit, and added tests to see if a week number was not found.

This compiles, but I can't test it.

Option Explicit

Private Sub Workbook_Open()
Dim colst As Long, colend As Long 'starting column of previous month and end column of previous month
Dim wknost As Integer 'first week of previous month
Dim wknoend As Integer 'last week of previous month. If week belongs also to current month, week earlier to be taken
Dim sht As Worksheet

wknost = DatePart("ww", DateSerial(Year(Now), Month(Now) - 1, 1), vbMonday, vbFirstFourDays)
wknoend = DatePart("ww", DateSerial(Year(Now), Month(Now), 1) - 1, vbMonday, vbFirstFourDays)

If wknoend = DatePart("ww", DateSerial(Year(Now), Month(Now), 1), vbMonday, vbFirstFourDays) Then _
wknoend = wknoend - 1
MsgBox "Start number: " & wknost & "; End number: " & wknoend


For Each sht In Worksheets
With sht
MsgBox sht.Name
colst = 0
colend = 0

With .Range("2:2")
colst = .Find(What:="Week " & wknost, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
MsgBox colst
If Not colst Then GoTo NextSheet 'If col number not a number other than zero

colend = .Find(What:="Week " & wknoend, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
MsgBox colend
If Not colend Then GoTo NextSheet
End With 'Range 2:2

.Unprotect Password:="test" 'Not needed, and don't want, before here
With .Range(Cells(1, colst), Cells(1, colend)).EntireColumn
MsgBox "With Range: " & .Address
.Locked = True
.FormulaHidden = True
End With
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test"

End With 'Sht
NextSheet:
Next sht
End Sub

[michal2287]

I added some troubleshooting msgboxes, shortened the code a bit, and added tests to see if a week number was not found.

This compiles, but I can't test it.
....

So I tried it and now it says: "Start number 22, end number 25", then the msg boxes appear. First name of the sheet appears and then another box saying 26. It repeats with some sheets and then it says
"Run-time error '91':Object variable or With block variable not set" Do you know what that means? Thank you :)

[SamT]

Do you know what that means?
Depends on which Sheet is being processed, which line of code Raises the Error, and what each MsgBox reported for that sheet.

You can call the MsgBoxes Sheet Name, Start Column Number, End Column Njumber, and Range Address when you tell us what they said.

Example post form you to us:

The Error was "Blah blah"
THe Error was Raised on line "Blah blah blah bla hblah blah"
The Sheet name was "blah, blah"
The Start columns was "num"
The End Colmn was "Num"
The Range Address was "ABC123"
And if you are not using exactly the last code posted, put the code you are using in your Post.

Remember, we can not see your computer monitor from here and we can not read your mind.

[michal2287]

Okay, I'm sorry, please see below, I hope it helps:

On this line (MsgBox "Start number: " & wknost & "; End number: " & wknoend) it says "Start number: 22; End number: 25"

then it MsgBox says "019 Ribas" - (that is the name of the sheet) on this line - "MsgBox sht.Name"

then MsgBox says "26" on this line - " MsgBox colst"

Then it goes all over again but with the name of next sheet. And then again, again and again. After few sheets the code stops and says "Run-time error '91':

Object variable or With block variable not set"

[SamT]

Much better reporting. Thank you.


So it is going to NextSheet even Null and zero are both supposed to = False, and Not(False) = True

Change both lines with colst and colend like this
current:
If Not colst Then GoTo NextSheet
Change to like
If Not colst > 0 Then GoTo NextSheet
and let us know what happens.

Be sure to post your version of the edited code.

[michal2287]

Okay, so now it says:

on the line (MsgBox "Start number: " & wknost & "; End number: " & wknoend) it says: "Start number: 22; End number: 25"

then on the line (MsgBox sht.Name) it says "019 Ribas"

then on the line (MsgBox colst) it says "26"

then on the line (MsgBox colend) it says "29"

then on the line (MsgBox "With Range: " & .Address) it says "With Range: $Z:$AC"

then it goes again on another sheet, same thing (the name of the sheet, then 26 and then 29) and then on this line (With .Range(Cells(1, colst), Cells(1, colend)).EntireColumn) it says "Run-time error '1004':
Application-defined or object-defined error"

[mdmackillop]

Add a "Watch" on colst and colend to see the values just before the code fails. Are there proper values?

[michal2287]

So I was thinking... I think I will copy and paste the first code into every sheet I have and change the name and it will work anyway... so I would like to thank you so much for your work, I really appreciate!

I have one more question. The first code I posted here locks only the previous month. Could you help me edit the code in a way that it would lock for example past 2 - 3 months?

or

I have this code. It locks everything except for current week and I added some exceptions too. Would you be that kind and help me either with editing this code - that it would allow whole month open except for one week or the one above?


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



iWeekNum = Application.WorksheetFunction.WeekNum(Now, 2)


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 = "Week 1" Then
.Unprotect Password:="password"
.Cells.Locked = True
.Columns(iColNum).Locked = False
.Range("B28:B33").Locked = False
.Range("E12:BD12").Locked = True
.Range("E1:BD1").Locked = True
.Range("E2:BD2").Locked = True
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End If
End With
Next
End Sub


Thank you so much! :)

[mdmackillop]

I think I will copy and paste the first code into every sheet I have and change the name
Better to put the code in one module and pass the sheet name to it as a variable.

If .Range("E2").Value = "Week1" Then
What values can E2 hold?

[michal2287]

Better to put the code in one module and pass the sheet name to it as a variable.

What values can E2 hold?

In a range E2:BD2 there are Week numbers. So E2 says week1, F2 says week2 etc.

[michal2287]

So I tried to edit one of the codes I had posted earlier and this one works for me now:


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



iWeekNum = Application.WorksheetFunction.WeekNum(Now, 2)


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 = "Week 1" Then
.Unprotect Password:="password"
.Cells.Locked = True
.Columns(iColNum).Locked = False
.Columns(iColNum - 1).Locked = False
.Columns(iColNum - 2).Locked = False
.Columns(iColNum - 3).Locked = False
.Columns(iColNum - 4).Locked = False
.Range("B28:B33").Locked = False
.Range("E12:BD12").Locked = True
.Range("E1:BD1").Locked = True
.Range("E2:BD2").Locked = True
.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlUnlockedCells
End If
End With
Next
End Sub

What it does is it locks everything except for current week and 4 weeks back and some the range cells I chose.

If the code makes sense I think we can lock this topic :-) Thank you so much guys for your help!!!

[SamT]

If it makes sense to you, you can use the "Thread Tools" menu above the thread to mark it "Solved."