Smart questions
Smart answers
Smart people
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Member Login

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!

Join Tek-Tips
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

LINK TO THIS FORUM!

Add Stickiness To Your Site By Linking To This Professionally Managed Technical Forum.
Just copy and paste the
code below into your site.

Partner With Us!

"Best Of Breed" Forums Add Stickiness To Your Site
Partner Button
(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?
shelby55 (TechnicalUser)
2 Jul 12 15:50
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:

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

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.
SkipVought (Programmer)
2 Jul 12 15:57

hi,

PROCESS:

Unprotect sheet

Change cell locking

Protect sheet

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
2 Jul 12 16:47
Hi Skip

I added the code:

CODE

wsAdd.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:

CODE

Private 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.
SkipVought (Programmer)
2 Jul 12 16:49


PROCESS:

Unprotect sheet

Change cell locking, values, formatting etc

Protect sheet

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
2 Jul 12 17:07
Thanks Skip, I figured it out!
SkipVought (Programmer)
2 Jul 12 17:10
smile

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
2 Jul 12 17:11
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.

SkipVought (Programmer)
2 Jul 12 17:14
Because the DV cell is locked?

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
2 Jul 12 17:17
It's not from the locked cell range.
SkipVought (Programmer)
2 Jul 12 17:21

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,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
2 Jul 12 17:26
Never mind, Skip, it's a problem with my validation tables that weren't working prior to adding this code.

Thanks.
SkipVought (Programmer)
2 Jul 12 17:28
upsidedown

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

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:

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

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):

CODE

Private 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.

SkipVought (Programmer)
29 Jul 12 16:33
"A5,

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

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

CODE

wsAdd.Unprotect
wsAdd.Cells.Locked = False 

to above the "for each t" line then it stops at

CODE

wsAdd.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.
SkipVought (Programmer)
29 Jul 12 18:33

CODE

wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft 
RIGHT in Range you have a PERIOD rather than a COMMA!

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

Helpful Member!  SkipVought (Programmer)
29 Jul 12 18:34
Rather than a COLON, sorry

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

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:

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

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.
SkipVought (Programmer)
29 Jul 12 20:59
WHY, WHY, WHY do you have tha allign &protect code inside the loop???

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
29 Jul 12 21:31
Actually, it's always been there from when you were helping me, Skip sad. 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.
SkipVought (Programmer)
29 Jul 12 21:40
Isn't wsAdd one worksheet, not different worksheets?

Step thru the code and discover what is happening when. Blood &sweat!

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
1 Aug 12 14:02
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.
SkipVought (Programmer)
1 Aug 12 14:28
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,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
1 Aug 12 16:04
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.
SkipVought (Programmer)
1 Aug 12 16:29
Locking/Unlocking is something that you do ONE TIME ONLY.

Once a sheet is UNPROTECTED, it matter NOT that cells are locked!

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

Helpful Member!  Hoaokapohaku (TechnicalUser)
1 Aug 12 16:36
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.
shelby55 (TechnicalUser)
1 Aug 12 17:00
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.....
shelby55 (TechnicalUser)
5 Aug 12 14:07
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.
SkipVought (Programmer)
5 Aug 12 17:15
It must be LOCKED!

Skip,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
5 Aug 12 21:09
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?
SkipVought (Programmer)
6 Aug 12 8:24

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,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

shelby55 (TechnicalUser)
6 Aug 12 10:25
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.
SkipVought (Programmer)
6 Aug 12 11:24
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,

glassesJust traded in my old subtlety...
for a NUANCE!tongue

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close