Working Code Stops Working When Freeze Range Extended

shellp · Jul 29, 2012

Hello

With the help of Skip Vought I was able to create an Excel 2010 application. VBA code that I have running takes data from a worksheet(RawData_A) and each row of data is plugged into a single worksheet. I freeze some of the cells so that users can't enter information in those cells but I've decided I want to expand that zone to A1:H79, I5:I79, K5:P38, N40:P61, Q5:Q79.

There is also a Worksheet_Change event in the Template worksheet that also unfreezes and freezes cells.

If I just simply change the range to the above I get a run-time error 1004 "PasteSpecial method of Range class failed".

Can someone please advise what am I missing as something that needs to be done so I can freeze the ranges I want to? Thanks very much!

Sub AbstractData:

Code:

Sub AbstractData()</SPAN></SPAN>
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet</SPAN></SPAN>
 
If worksheetexists("1") Then</SPAN></SPAN>
MsgBox "Abstracts have already been created"</SPAN></SPAN>
 
Else</SPAN></SPAN>
 
With Sheets("RawData_A")</SPAN></SPAN>
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")</SPAN></SPAN>
 
If Not rSEQ_NO Is Nothing Then</SPAN></SPAN>
For Each r In .Range(.[A2], .[A2].End(xlDown))</SPAN></SPAN>
 
Sheets("Template").Copy After:=Sheets(Sheets.Count)</SPAN></SPAN>
Set wsAdd = ActiveSheet</SPAN></SPAN>
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value</SPAN></SPAN>
wsAdd.Tab _</SPAN></SPAN>
.Color = 49407</SPAN></SPAN>
 
For Each t In [From]</SPAN></SPAN>
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy</SPAN></SPAN>
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _</SPAN></SPAN>
Paste:=xlPasteAll, _</SPAN></SPAN>
Operation:=xlNone, _</SPAN></SPAN>
SkipBlanks:=False, _</SPAN></SPAN>
Transpose:=False</SPAN></SPAN>
 
wsAdd.Unprotect</SPAN></SPAN>
wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft</SPAN></SPAN>
wsAdd.Range("A5.J80").VerticalAlignment = xlTop</SPAN></SPAN>
wsAdd.Cells.Locked = False</SPAN></SPAN>
wsAdd.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True</SPAN></SPAN>
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True</SPAN></SPAN>
Next</SPAN></SPAN>
Next</SPAN></SPAN>
End If</SPAN></SPAN>
End With</SPAN></SPAN>
 
End If</SPAN></SPAN>
End Sub

Worksheet_Change Event:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)</SPAN></SPAN>
    Dim t As Range, rng As Range</SPAN></SPAN>
   
    Set rng = Union( _</SPAN></SPAN>
        Intersect(Rows("5:37"), Range([b1], [j1]).EntireColumn), _</SPAN></SPAN>
        Intersect(Rows("40:60"), Range([b1], [m1]).EntireColumn), _</SPAN></SPAN>
        Intersect(Rows("63:79"), Range([b1], [p1]).EntireColumn))</SPAN></SPAN>
       
       
    Me.Unprotect</SPAN></SPAN>
    Me.Cells.Locked = False</SPAN></SPAN>
   
    For Each t In Target</SPAN></SPAN>
        With t</SPAN></SPAN>
       
        'is change in column J?</SPAN></SPAN>
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then</SPAN></SPAN>
                If t.Value <> Cells(t.Row, "B").Value Then</SPAN></SPAN>
                    .Interior.Color = 49407</SPAN></SPAN>
                  Else</SPAN></SPAN>
                    .Interior.ColorIndex = xlColorIndexNone</SPAN></SPAN>
                End If</SPAN></SPAN>
            End If</SPAN></SPAN>
       
       'is change in column K?</SPAN></SPAN>
        If Not Intersect(t, rng, Cells(1, "K").EntireColumn) Is Nothing Then</SPAN></SPAN>
                If t.Value <> Cells(t.Row, "C").Value Then</SPAN></SPAN>
                    .Interior.Color = 49407</SPAN></SPAN>
                  Else</SPAN></SPAN>
                    .Interior.ColorIndex = xlColorIndexNone</SPAN></SPAN>
                End If</SPAN></SPAN>
            End If</SPAN></SPAN>
 
        End With</SPAN></SPAN>
    Next</SPAN></SPAN>
        Set rng = Nothing</SPAN></SPAN>
       
    Me.Range("A1:A79,C5:H38,F40:H61,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True</SPAN></SPAN>
    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True</SPAN></SPAN>
   
End Sub

AlphaFrog · Jul 29, 2012

I'm not sure I follow everything. Maybe unprotect the wsAdd sheet before you paste to it.

Code:

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

    wsAdd.Range("A5.J80").HorizontalAlignment = xlLeft
    wsAdd.Range("A5.J80").VerticalAlignment = xlTop
    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

shellp · Jul 29, 2012

Hi AlphaFrog

Thanks for responding.

As I mentioned, it works as is right now. But if I change the range, then it doesn't and I get the run-time error posted.

I moved/added the following lines to the location you pointed to:

Code:

wsadd.Unprotect
wsAdd.Cells.Locked = false
wsAdd.Range("A1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").locked = false

...and I get the run-time error "unable to set the HorizontalAlignment property of the Range Class". Until it stops, the code produces the first worksheet which didn't fill in data for B5 to B7 and J5 to J7 when it should have (there is no missing data) but filled in cells B8 and J8. Also, all the cells that should be frozen are. Just commenting to figure out what it is doing. Any thoughts?

AlphaFrog · Jul 29, 2012

When the code errors and you End the process, is the worksheet actually protected or not at that point?

Is the Private Sub Worksheet_Change event procedure in the new wsAdd worksheet's code module? If yes, it could be re-protecting the sheet each time you paste (change) the sheet with your AbstractData code. You may think you unprotected the sheet, but the Worksheet_Change ebvent procedure reprotects it after each paste. If it is, then you could use Application.EnableEvents = False to suspend any event macros from triggering when you make changes to wsAdd.

shellp · Jul 29, 2012

Good question, AlphaFrog....it is protected after it stops. I did as you suggested in the Sub AbstractData() but the results are still the same.

AlphaFrog · Jul 29, 2012

shellp said:
I did as you suggested in the Sub AbstractData() but the results are still the same.

Can you show exactly what you did?

shellp · Jul 29, 2012

Hi

Please see code below:

Code:

Sub AbstractData()</SPAN></SPAN>
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet</SPAN></SPAN>
 
If worksheetexists("1") Then</SPAN></SPAN>
MsgBox "Abstracts have already been created"</SPAN></SPAN>
 
Else</SPAN></SPAN>
Application.EnableEvents = False</SPAN></SPAN>
 
With Sheets("RawData_A")</SPAN></SPAN>
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")</SPAN></SPAN>
 
If Not rSEQ_NO Is Nothing Then</SPAN></SPAN>
For Each r In .Range(.[A2], .[A2].End(xlDown))</SPAN></SPAN>
 
 
Sheets("Template").Copy After:=Sheets(Sheets.Count)</SPAN></SPAN>
Set wsAdd = ActiveSheet</SPAN></SPAN>
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value</SPAN></SPAN>
wsAdd.Tab _</SPAN></SPAN>
.Color = 49407</SPAN></SPAN>
 
wsAdd.Unprotect</SPAN></SPAN>
wsAdd.Cells.Locked = False</SPAN></SPAN>
wsAdd.Range("A1:A79,B1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = False
 
For Each t In [From]</SPAN></SPAN>
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy</SPAN></SPAN>
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _</SPAN></SPAN>
Paste:=xlPasteAll, _</SPAN></SPAN>
Operation:=xlNone, _</SPAN></SPAN>
SkipBlanks:=False, _</SPAN></SPAN>
Transpose:=False</SPAN></SPAN>
 
wsAdd.Range("A5:J80").HorizontalAlignment = xlLeft</SPAN></SPAN>
wsAdd.Range("A5:J80").VerticalAlignment = xlTop</SPAN></SPAN>
wsAdd.Range("A1:A79,B1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True</SPAN></SPAN>
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True</SPAN></SPAN>
Next</SPAN></SPAN>
Next</SPAN></SPAN>
End If</SPAN></SPAN>
End With</SPAN></SPAN>
 
With Sheets("RawData_A")</SPAN></SPAN>
.Activate</SPAN></SPAN>
.Visible = xlSheetHidden</SPAN></SPAN>
End With</SPAN></SPAN>
 
With Sheets("RawDataA_Map")</SPAN></SPAN>
.Activate</SPAN></SPAN>
.Visible = xlSheetHidden</SPAN></SPAN>
End With</SPAN></SPAN>
 
With Sheets("Template")</SPAN></SPAN>
.Activate</SPAN></SPAN>
.Visible = xlSheetHidden</SPAN></SPAN>
End With</SPAN></SPAN>
End If</SPAN></SPAN>
Application.EnableEvents = True</SPAN></SPAN>
End Sub

Please note that there was an error in the Range referenced in the HorizontalAlignment format which has been changed. The code above produces a run time error indicating "the cell or chart that you are trying to change is protected and therefore read only". So obviously I'm not putting the code in the right spot.

AlphaFrog · Jul 29, 2012

You're doing the Application.EnableEvents = False corectly. Be sure to re-enable the events at the end of the macro.

You are re-protecting wsAdd within the For Each t In [From] loop before you are done pasting

Code:

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:A79,B1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
[COLOR="#FF0000"]wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True[/COLOR]
Next t

So for the first t, you are unprotected. The next t, you are protected.

Try this...

Code:

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
[COLOR="#FF0000"]Next t[/COLOR]

wsAdd.Range("A5:J80").HorizontalAlignment = xlLeft
wsAdd.Range("A5:J80").VerticalAlignment = xlTop
wsAdd.Range("A1:A79,B1:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

shellp · Jul 29, 2012

THANK YOU!!! That was it!!

In the original code provided, I had the code of Application.EnableEvents = False but I didn't use that in the version that worked so I'm assuming it's not necessary? Below is the version that I ran that worked:

Code:

Sub AbstractData()</SPAN></SPAN>
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet</SPAN></SPAN>
 
If worksheetexists("1") Then</SPAN></SPAN>
MsgBox "Abstracts have already been created"</SPAN></SPAN>
 
Else</SPAN></SPAN>
 
With Sheets("RawData_A")</SPAN></SPAN>
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")</SPAN></SPAN>
 
If Not rSEQ_NO Is Nothing Then</SPAN></SPAN>
For Each r In .Range(.[A2], .[A2].End(xlDown))</SPAN></SPAN>
 
 
Sheets("Template").Copy After:=Sheets(Sheets.Count)</SPAN></SPAN>
Set wsAdd = ActiveSheet</SPAN></SPAN>
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value</SPAN></SPAN>
wsAdd.Tab _</SPAN></SPAN>
.Color = 49407</SPAN></SPAN>
 
wsAdd.Unprotect</SPAN></SPAN>
wsAdd.Cells.Locked = False</SPAN></SPAN>
wsAdd.Range("A1:A79,B5:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = False</SPAN></SPAN>
 
For Each t In [From]</SPAN></SPAN>
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy</SPAN></SPAN>
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _</SPAN></SPAN>
Paste:=xlPasteAll, _</SPAN></SPAN>
Operation:=xlNone, _</SPAN></SPAN>
SkipBlanks:=False, _</SPAN></SPAN>
Transpose:=False</SPAN></SPAN>
Next t</SPAN></SPAN>
 
 
wsAdd.Unprotect</SPAN></SPAN>
wsAdd.Range("A5:J80").HorizontalAlignment = xlLeft</SPAN></SPAN>
wsAdd.Range("A5:J80").VerticalAlignment = xlTop</SPAN></SPAN>
wsAdd.Cells.Locked = False</SPAN></SPAN>
wsAdd.Range("A1:A79,B5:H79,I5:I79,K5:P38,N40:P61,Q5:Q79").Locked = True</SPAN></SPAN>
wsAdd.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True</SPAN></SPAN>
Next</SPAN></SPAN>
 
End If</SPAN></SPAN>
End With</SPAN></SPAN>
 
With Sheets("RawData_A")</SPAN></SPAN>
.Activate</SPAN></SPAN>
.Visible = xlSheetHidden</SPAN></SPAN>
End With</SPAN></SPAN>
 
With Sheets("RawDataA_Map")</SPAN></SPAN>
.Activate</SPAN></SPAN>
.Visible = xlSheetHidden</SPAN></SPAN>
End With</SPAN></SPAN>
 
With Sheets("Template")</SPAN></SPAN>
.Activate</SPAN></SPAN>
.Visible = xlSheetHidden</SPAN></SPAN>
End With</SPAN></SPAN>
 
End If</SPAN></SPAN>
End Sub

Thanks again, AlphaFrog!!

shellp · Jul 29, 2012

Hi

Sorry but there is still something not working correctly. I added the Application.EnableEvents = False back into the formula so I now get the abstracts created BUT column J is now locked once the workbook is protected. I checked the Template document that each of the worksheets is copied from and that column is entirely unlocked (and never has been locked). When the code runs this column is locked and if I unprotect the worksheet, the format cells/protection indicates locked. These cells are never locked anywhere so I'm not sure what is happening...any thoughts would be greatly appreciated.

Thanks.

Working Code Stops Working When Freeze Range Extended

shellp

Board Regular

Excel Facts

AlphaFrog

MrExcel MVP

shellp

Board Regular

AlphaFrog

MrExcel MVP

shellp

Board Regular

AlphaFrog

MrExcel MVP

shellp

Board Regular

AlphaFrog

MrExcel MVP

shellp

Board Regular

shellp

Board Regular

Similar threads

Forum statistics

Share this page

Working Code Stops Working When Freeze Range Extended

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock