INTELLIGENT WORK FORUMS FOR COMPUTER PROFESSIONALS
Come Join Us!
Are you a Computer / IT professional? Join Tek-Tips now!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- One-Click Access To Your
Favorite Forums
- Automated Signatures
On Your Posts
- Best Of All, It's Free!
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.
Partner With Us!
"Best Of Breed" Forums Add Stickiness To Your Site

(Download This Button Today!)
Feedback
"...I have to add my thanks and appreciation for your wonderful site... People who frequent the site are the two best things - nice and smart..."
Geography
Where in the world do Tek-Tips members come from?
|
Protect Certain Cells in Excel? (2)
|
|
Hello
With help from Skip I've been able to create many worksheets from a single worksheet. Each worksheet is one patient visit of data.
The code is:
CODESub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, mypassword As String, ws As Worksheet
With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")
If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
wsAdd.Tab _
.Color = 49407
For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft
Next
Next
End If
End With
End Sub
What I would like to do is have some cells frozen so no data can be entered. I'm not sure if I first unlock the cells in the worksheet "Template" that is being copied and then protect each worksheet after that or not. I've tried to add the code to below the horizontal alignment but I get an error message and the code stops so not sure where I would put this piece of the code.
Any and all help greatly appreciated - thanks.
|
|
hi,
PROCESS:
Unprotect sheet
Change cell locking
Protect sheet Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Hi Skip
I added the code:
CODEwsAdd.Unprotect
wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft
wsAdd.Cells.Locked = False
wsAdd.Range("C5:H39,F41:H62,K5:P39,N41:P62").Locked = True
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
What I want is to be able to edit the unlocked cells, which I am, but that interferes with the change cell colour on change of information in Column J from Column B:
CODEPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range, rng As Range
Set rng = Intersect(Rows("5:38"), Range([b1], [j1]).EntireColumn)
For Each t In Target
With t
'is change in column J?
If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "B").Value Then
.Interior.Color = 49407
Else
End If
End If
End With
Next
Set rng = Nothing
End Sub
It stops at the line .interior.color = 49407. Why would that be? Thanks.
|
|
PROCESS:
Unprotect sheet
Change cell locking, values, formatting etc
Protect sheet Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Thanks Skip, I figured it out! |
|
Hi Skip
I spoke too soon....for the unlocked cells they are editable in terms of changing data in the cell but the lists attached via data validation don't work i.e. the pull down arrow doesn't work.
Why would that be? Thanks.
|
|
Because the DV cell is locked? Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
It's not from the locked cell range. |
|
Quote:but the lists attached via data validation don't work i.e. the pull down arrow doesn't work.
Are you referring to the LISTS or the Data Validation LIST control? Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Never mind, Skip, it's a problem with my validation tables that weren't working prior to adding this code.
Thanks. |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 13:20 |
Hi
The following code is working as it should to extract data from each row of RawData to a separate worksheet. All cells where there is data are not frozen, all those not requiring any data to be entered are frozen:
CODESub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet
If worksheetexists("1") Then
MsgBox "Abstracts have already been created"
Else
With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")
If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
wsAdd.Tab _
.Color = 49407
For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
wsAdd.Unprotect
wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft
wsAdd.Cells.Locked = False
wsAdd.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
Next
End If
End With
With Sheets("RawData_A")
.Activate
.Visible = xlSheetHidden
End With
With Sheets("RawDataA_Map")
.Activate
.Visible = xlSheetHidden
End With
With Sheets("Template")
.Activate
.Visible = xlSheetHidden
End With
End If
End Sub
Because cells A1 to H79 aren't to be edited anyway, I've decided I wish to expand the freezing of A1 to H79. However, when just making only that change in the code, I get an error at wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft.
I'm thinking Process that you explained but not understanding why this isn't working. I even tried to move the wsAdd.Unprotect further up the code but that didn't work either. Any help greatly appreciated - thanks. |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 13:25 |
Hi
I didn't know if this would help, but on the Template worksheet there is also some code unprotecting and protecting the specific ranges and I did change them to reflect the new range but didn't know if that would have something to do with the other not working.
That code is (which Skip helped with writing):
CODEPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range, rng As Range
Set rng = Union( _
Intersect(Rows("5:37"), Range([b1], [j1]).EntireColumn), _
Intersect(Rows("40:60"), Range([b1], [m1]).EntireColumn), _
Intersect(Rows("63:79"), Range([b1], [p1]).EntireColumn))
Me.Unprotect
Me.Cells.Locked = False
For Each t In Target
With t
'is change in column J?
If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "B").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
'is change in column K?
If Not Intersect(t, rng, Cells(1, "K").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "C").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
'is change in column L?
If Not Intersect(t, rng, Cells(1, "L").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "D").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
'is change in column M?
If Not Intersect(t, rng, Cells(1, "M").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "E").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
'is change in column N?
If Not Intersect(t, rng, Cells(1, "N").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "F").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
'is change in column O?
If Not Intersect(t, rng, Cells(1, "O").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "G").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
'is change in column P?
If Not Intersect(t, rng, Cells(1, "P").EntireColumn) Is Nothing Then
If t.Value <> Cells(t.Row, "H").Value Then
.Interior.Color = 49407
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End If
End With
Next
Set rng = Nothing
Me.Range("A1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Thanks.
|
|
"A5 , Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 17:33 |
Skip, can you be just a tad more wordy? I changed the current code to be "A5:H79,I5:I79,K5:P38,N40:P61,Q5:Q79" but it stops at PasteSpecial point of the code.
When it stops it has produced the first abstract and not copied any data into B5 to B7 or J5 to J7 (and there is data to do so) BUT added data in B8 and J8 before stopping. The ranges noted above are locked.
Really appreciate your help! |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 17:38 |
P.S.
If I add
CODEwsAdd.Unprotect
wsAdd.Cells.Locked = False
to above the "for each t" line then it stops at
CODEwsAdd.Range("A5.J80").HorizontalAlignment = xlLeft
Same results as previous as to producing first worksheet, filling in row 8 but not the previous rows and all locking as appropriate. |
|
CODEwsAdd.Range("A5.J80").HorizontalAlignment = xlLeft
RIGHT in Range you have a PERIOD rather than a COMMA! Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Rather than a COLON, sorry Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 18:44 |
Hi Skip
I fixed that, thanks, but the code still isn't working. This is what I have so far and it still stops at the horizontalalignment step. It also only fills in B8/J8 but nothing before it.
Thanks. |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 18:45 |
Sorry, forgot to post code:
CODESub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet
If worksheetexists("1") Then
MsgBox "Abstracts have already been created"
Else
With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")
If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
wsAdd.Tab _
.Color = 49407
wsAdd.Unprotect
wsAdd.Cells.Locked = False
For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
wsAdd.Range("A5:J80").HorizontalAlignment = xlLeft
wsAdd.Range("A5:J80").VerticalAlignment = xlTop
wsAdd.Range("A1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
Next
End If
End With
End If
End Sub |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 20:24 |
Hey Skip,
Thanks for your help but I got the answer from another site. The issue was that I was re-protecting wsAdd within the For Each t In [From] loop before the pasting had completed.
So I added "next t" after the paste line (and took the other "next" from after the formatting comments) and it works like a charm
Thanks again for your patience. |
|
WHY, WHY, WHY do you have tha allign &protect code inside the loop???
Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
|
shelby55 (TechnicalUser) |
29 Jul 12 21:31 |
Actually, it's always been there from when you were helping me, Skip  . Doesn't it have to be in the loop so each worksheet is formatted correctly?
And the new code isn't working anyway because for some reason it is now freezing the J column. So the template has the column of J completely not locked (format cell, protection, locked is de-selected) but when any of the new worksheets derived from Template are activated, J is frozen. When I unprotect the worksheet, J's cells have format cell, protection, locked selected.
The current code is working in terms of running and freezing all of A1 to I79, incorrectly freezes J5 to J38, but correctly freezes all the other cells required. Actually something odd happened too where all 5 abstracts were frozen with J5 to J38 but I unprotected then reprotected it and they were fine so not sure what is going on.
Code:
[Sub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet
If worksheetexists("1") Then
MsgBox "Abstracts have already been created"
Else
Application.EnableEvents = False
With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")
If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
wsAdd.Tab _
.Color = 49407
wsAdd.Unprotect
wsAdd.Cells.Locked = False
'wsAdd.Range("A1:A79,B5:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = False
For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Next t
wsAdd.Unprotect
wsAdd.Range("A5:J80").HorizontalAlignment = xlLeft
wsAdd.Range("A5:J80").VerticalAlignment = xlTop
wsAdd.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
End If
End With
With Sheets("RawData_A")
.Activate
.Visible = xlSheetHidden
End With
With Sheets("RawDataA_Map")
.Activate
.Visible = xlSheetHidden
End With
With Sheets("Template")
.Activate
.Visible = xlSheetHidden
End With
End If
Application.EnableEvents = True
End Sub[/code]
Any help appreciated, Skip. |
|
Isn't wsAdd one worksheet, not different worksheets?
Step thru the code and discover what is happening when. Blood &sweat! Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Hi Skip
I've asked before, how do I step through the code to find out what is happening. For example, when I try to do this it just runs the code with the results but doesn't show me in the intermediate window what the result is.
For the above I've been able to change the code to ensure that the cells I wanted unlocked are included in the code so that fixed that but I'm having issues where I can unlock the cells by scrolling through them...does that make sense?
Also, do I have to protect each worksheet with a password if I don't want users to be able to unprotect from the Information Page? Thanks. |
|
I've asked before, how do I step through the code to find out what is happening. For example, when I try to do this it just runs the code with the results but doesn't show me in the intermediate window what the result is.
When you STEP thru your code you can use the Watch Window to observe the value of a variable or object. NOTHING will be in the Immediate Window unless you EXPLICITLY put it there, for instance using Debug.Print in your CODE. FAQ707-4594: How to use the Watch Window as a Power Programming Tool
The other thing that STEPping does, it shows how your control structure is working.
For the above I've been able to change the code to ensure that the cells I wanted unlocked are included in the code so that fixed that but I'm having issues where I can unlock the cells by scrolling through them...does that make sense?
I would not mess with LOCKING. Just leave that as it is. The ONLY thing you need to change to maintain data on the sheet is to UNPROTECT the sheet.
Also, do I have to protect each worksheet with a password if I don't want users to be able to unprotect from the Information Page?
Naturally, a Password is required, if you don't want users to unprotect your sheet.
Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Hi Skip
Thanks for the response but I'm not sure what you mean by "I would not mess with LOCKING"?
As you can see from my code, the cells are locked or not based on whether I want users to be able to edit the cells. All cells from A1 to H74 are locked so that when the worksheet is protected they can't be edited.
OR are you saying, that leave them as locked in the template (which is the worksheet format that is copied for each abstract) but don't refer to locked or unlocked in the code because that won't be an issue until the worksheet is protected? So your process comments about unprotect, do whatever and protect is only referring to the worksheet?
Thanks. |
|
Locking/Unlocking is something that you do ONE TIME ONLY.
Once a sheet is UNPROTECTED, it matter NOT that cells are locked!
Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
I don't know if this is helpful to you or not because I only skimmed the thread, but if you need to unprotect and then protect your sheets again in order for your macro to be able to run, the following code might be helpful:
Private Sub Workbook_Open()
Dim wSheet As Worksheet
For Each wSheet In Worksheets
wSheet.Protect Password:="whatever", UserInterFaceOnly:=True
Next wSheet
End Sub
In your VBA editor, if you paste this code in the "ThisWorkbook" object, it will turn on protection with the same password for all sheets each time the workbook is opened. Just edit the password between the quotation marks in the code to whatever password you want. In addition, it will allow your macros to run on protected sheets without having to add code to unprotect your worksheets and then add code to protect them once again. |
|
Hi
Thanks very much to you both...Hoaokapohaku, that may very well be useful so I'll take a look at it.
I will also review my code to see what/when is protected versus unprotected. Just an FYI Skip that the code I'm using you helped write so I'm unsure why now you're telling me it's not correct..... |
|
Hi Skip
So I took off the locked/unlock cells comments but now when I go into one of the resulting abstracts sheets and try to access one of the cells I should be able to access (because it was formatted as unlocked from the template), I get an error message that it's locked.
Why would that be? Thanks. |
|
It must be LOCKED! Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Skip,
I'm not sure you're understanding but the template (which gets copied to become the abstracts of one per each line of raw data) is supposed to have the certain cells locked and some unlocked. The unlocked can be edited/added or subtracted. In the template they are locked/unlocked as they should be but when I protect the worksheet they aren't thus the need to lock/unlock cells as part of the code.
What am I missing here? |
|
You need to do a FIND on your entire PROJECT for .Lock.
I deduce that you have somewhere locked cells that should be unlocked. LOCKING does not magically change when you use a template.
Your code really does not need to perform changes in cell locking when UNPROTECTING the sheet, unless you want to change LOCKING based on some user action. Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
Hi
I've checked and the only .lock that I have is what I've provided in this thread.
It is in the template for the Worksheet_Change code and in the sub Abstract() that copies all the worksheets from Template based on RawData.
So with the way it is written now, when I got into the worksheet the cells I want locked are but if I say copy from the locked cells then they are no longer locked. Or if the Worksheet_Change code fires then those cells are unlocked.
You indicated I needed to unprotect action protect in order to run the Worksheet_Change code but why would it unlock them with the way it is written? Thanks. |
|
I'm not sure what is happening. This thread has wandered over several issues, so referencing something formerly posted is vague and I'm not going to venture a guess at the code that you might be referring to.
If you COPY/PASTE from the template or any other sheet, then your CELL FORMATTING, including protection, ought to and WILL be identical, AT THAT POINT IN TIME.
If, however, you COPY/PASTE from somewhere else, in the course of time, having LOCKED cells, then guess what? You have changed the cell protection format.
So at that point, I suppose that specifically specifying the UNLOCKED ranges, would be a necessity before PROTECTING the sheet. Skip,
Just traded in my old subtlety...
for a NUANCE! |
|
|
 |
|