# VBA resize table on a protected sheet



## willow1985

Hello,

I have been trying to solve a problem with a table that is on a protected sheet.

As I am sure many of you know Tables do not auto expand when the sheet is protected. I do however need the table to expand and have the sheet protected.

Any advise on a work around for this would be greatly appreciated.

Note: One of my ideas was to set off a macro when new data was entered in column C that would unlock the spreadsheet, expand the table and then re-lock the spreadsheet but I cannot seem to make this work/find the right code to expand the table without knowing the exact range.

The data starts at A3 and goes to the last row of data in column W, however there are some blanks periodically in various columns. The only column that does not have any blanks is column C.

The locked formulas are in columns L,M and N, there are other formulas that are not locked however in other columns.

There will also be situations when a macro will dump large blocks of data will be pasted in the last blank row in column A to column G so I don't know if using "new data in column C" as a trigger would work..

I hope someone can help as I feel stumped on this one.

My table name is "MF"

Thank you!



		VBA Code:
__


If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Value <> "" Then

  
        Worksheets("Master Forecast").Unprotect Password:="2150"

'Code to resize table or bring down data by 1 row??

Worksheets("Master Forecast").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True, Password:="2150"

End If
End Sub


----------



## jasonb75

Bit of a wild idea, but how about using selection change to unlock the sheet when the use selects a range that can be edited or to protect it when they select a range that should be locked?
That should allow the table to resize automatically.



willow1985 said:


> There will also be situations when a macro will dump large blocks of data will be pasted in the last blank row in column A to column G so I don't know if using "new data in column C" as a trigger would work..



Simply add unprotect code to the beginning of that macro and protect code at the end. There is another method if you have several macros that all require access to a protected sheet, but this is easier if it's only for one. Again, this should allow it to resize automatically.


----------



## willow1985

jasonb75 said:


> Bit of a wild idea, but how about using selection change to unlock the sheet when the use selects a range that can be edited or to protect it when they select a range that should be locked?
> That should allow the table to resize automatically.
> 
> 
> 
> Simply add unprotect code to the beginning of that macro and protect code at the end. There is another method if you have several macros that all require access to a protected sheet, but this is easier if it's only for one. Again, this should allow it to resize automatically.




I am not sure what you mean by using selection change to unlock the sheet etc. I am still very new to vba and a lot of the terms.
Could you give an example of the code?


----------



## jasonb75

Sure, here's a quick example based on what you had in post 1, this goes into the worksheet module (right click sheet name in excel, then view code).

If the selected range includes any cell(s) in columns L:N then the sheet will be locked, if the selected range doesn't include any of those columns then the sheet will be locked.


		VBA Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L:N")) Is Nothing Then
    Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True, Password:="2150"
Else
    Me.Unprotect Password:="2150"
End If
End Sub

Note that this will most likely not work with your macro to bulk copy and paste, in which case, you can simply unprotect as the first part of that macro and reprotect as the last thing.


----------



## willow1985

It worked however now it will not allow me to unprotect the sheet manually now. Every time I do it seems to instantly re-protect it...
I tried un-protecting it to delete the test row I made but as soon as I select the row it protects the sheet again.

Certain individuals still need to be able to unprotect it to make adjustments and not have it lock on them. Is there any way to make it only execute if new data is entered in column C?


----------



## willow1985

jasonb75 said:


> Sure, here's a quick example based on what you had in post 1, this goes into the worksheet module (right click sheet name in excel, then view code).
> 
> If the selected range includes any cell(s) in columns L:N then the sheet will be locked, if the selected range doesn't include any of those columns then the sheet will be locked.
> 
> 
> VBA Code:
> __
> 
> 
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> If Not Intersect(Target, Range("L:N")) Is Nothing Then
> Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
> False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
> AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
> :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
> AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
> AllowUsingPivotTables:=True, Password:="2150"
> Else
> Me.Unprotect Password:="2150"
> End If
> End Sub
> 
> Note that this will most likely not work with your macro to bulk copy and paste, in which case, you can simply unprotect as the first part of that macro and reprotect as the last thing.



It worked however now it will not allow me to unprotect the sheet manually to make adjustments. Every time I do it seems to instantly re-protect it...
I tried un-protecting it to delete the test row I made but as soon as I select the row it protects the sheet again.

Certain individuals still need to be able to unprotect it to make adjustments and not have it lock on them. Is there any way to make it only execute if new data is entered in column C?


----------



## jasonb75

willow1985 said:


> I tried un-protecting it to delete the test row I made but as soon as I select the row it protects the sheet again


If you select a single cell then right click and delete the row without selecting then it over-rides this. The idea seemed good earlier, but in hindsight I think it's leaving the sheet too vulnerable.

I'll give it some more thought, I think that I can get your idea to work but need to set up a sheet and test it first, although I don't think that I'll get it done until tomorrow now.


----------



## willow1985

jasonb75 said:


> If you select a single cell then right click and delete the row without selecting then it over-rides this. The idea seemed good earlier, but in hindsight I think it's leaving the sheet too vulnerable.
> 
> I'll give it some more thought, I think that I can get your idea to work but need to set up a sheet and test it first, although I don't think that I'll get it done until tomorrow now.



Thank you very much.  My Goal is mainly to protect the formulas located in L:N, the headers of the table (Row 2) and 1 cell in A1.

I am fine with the users deleting rows, just not columns. In fact it will be a common practice for the users to delete rows. 
Most of the individuals who will be using the sheet are pretty competent but as a precaution we are trying to avoid a slip up of deleting a formula or table header by mistake.

Thank you again for all of your help. I will check back tomorrow.


----------



## willow1985

jasonb75 said:


> If you select a single cell then right click and delete the row without selecting then it over-rides this. The idea seemed good earlier, but in hindsight I think it's leaving the sheet too vulnerable.
> 
> I'll give it some more thought, I think that I can get your idea to work but need to set up a sheet and test it first, although I don't think that I'll get it done until tomorrow now.



Here is a link to an example sheet if this helps.

Note: This is not the original sheet and I did not protect the sheet with a password









						Dropbox - File Deleted
					

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!




					www.dropbox.com


----------



## willow1985

The closest I have gotten is creating a macro that will run any time new data is entered in column C:



		VBA Code:
__


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Value <> "" Then Call Macro5
  End If
End Sub


Then Macro5 runs:



		VBA Code:
__


Worksheets("Master Forecast").Unprotect Password:="2150"

Range("L2").End(xlDown).Select

ActiveCell.Range("A1:C1").Select

Selection.AutoFill Destination:=ActiveCell.Range("A1:C2"), Type:= _

xlFillDefault

Worksheets("Master Forecast").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _

AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _

:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _

AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _

AllowUsingPivotTables:=True, Password:="2150"


This brings down the formula in L:N but it also moves any new typed data down a row. Close but no cigar *sigh

I hope you guys have better ideas then I do ?


----------



## willow1985

Hello,

I have been trying to solve a problem with a table that is on a protected sheet.

As I am sure many of you know Tables do not auto expand when the sheet is protected. I do however need the table to expand and have the sheet protected.

Any advise on a work around for this would be greatly appreciated.

Note: One of my ideas was to set off a macro when new data was entered in column C that would unlock the spreadsheet, expand the table and then re-lock the spreadsheet but I cannot seem to make this work/find the right code to expand the table without knowing the exact range.

The data starts at A3 and goes to the last row of data in column W, however there are some blanks periodically in various columns. The only column that does not have any blanks is column C.

The locked formulas are in columns L,M and N, there are other formulas that are not locked however in other columns.

There will also be situations when a macro will dump large blocks of data will be pasted in the last blank row in column A to column G so I don't know if using "new data in column C" as a trigger would work..

I hope someone can help as I feel stumped on this one.

My table name is "MF"

Thank you!



		VBA Code:
__


If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Value <> "" Then

  
        Worksheets("Master Forecast").Unprotect Password:="2150"

'Code to resize table or bring down data by 1 row??

Worksheets("Master Forecast").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True, Password:="2150"

End If
End Sub


----------



## Fluff

How about
	
	
	
	
	
	




		VBA Code:
__


Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("C:C")) Is Nothing Then
         Me.Unprotect Password:="2150"
         With Me.ListObjects("table1")
            .Resize .Range(1).CurrentRegion
         End With
         'Code to resize table or bring down data by 1 row??
         
         Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
            False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
            :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
            AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
            AllowUsingPivotTables:=True, Password:="2150"
   End If
End Sub


----------



## jasonb75

Looking at @Fluff's suggestion, I think I've been seriously trying to over-complicate things.

That looks like it should work so I'm going to wait for feedback before attempting anything else.


----------



## willow1985

Fluff said:


> How about
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 
> VBA Code:
> __
> 
> 
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Not Intersect(Target, Range("C:C")) Is Nothing Then
> Me.Unprotect Password:="2150"
> With Me.ListObjects("table1")
> .Resize .Range(1).CurrentRegion
> End With
> 'Code to resize table or bring down data by 1 row??
> 
> Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
> False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
> AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
> :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
> AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
> AllowUsingPivotTables:=True, Password:="2150"
> End If
> End Sub



Got the following error:






For line:   .Resize .Range(1).CurrentRegion

My Sheet looks like this (so not sure why getting this error?)


----------



## Fluff

Do you have anything in row 1?


----------



## willow1985

1 Formula in A1 to calculate today's date: =Today()

Sorry should have specified that. otherwise Row 1 is blank and is not part of the Table ("ML")


----------



## Fluff

Ok, how about
	
	
	
	
	
	




		VBA Code:
__


         With Me.ListObjects("table1")
            .Resize .Range(1).CurrentRegion.Offset(1).Resize(.Range(1).CurrentRegion.Rows.Count - 1)
         End With


----------



## willow1985

Works Perfect!

Thank you so much! This is exactly what I was looking for ??


----------



## willow1985

Fluff said:


> Ok, how about
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 
> VBA Code:
> __
> 
> 
> With Me.ListObjects("table1")
> .Resize .Range(1).CurrentRegion.Offset(1).Resize(.Range(1).CurrentRegion.Rows.Count - 1)
> End With



I really owe you a coffee ?

Thank you again


----------



## willow1985

jasonb75 said:


> Looking at @Fluff's suggestion, I think I've been seriously trying to over-complicate things.
> 
> That looks like it should work so I'm going to wait for feedback before attempting anything else.



And thank you jasonb75 for not giving up on me ??


----------



## Fluff

Glad we could help & thanks for the feedback.


----------



## willow1985

Hello,

I have been trying to solve a problem with a table that is on a protected sheet.

As I am sure many of you know Tables do not auto expand when the sheet is protected. I do however need the table to expand and have the sheet protected.

Any advise on a work around for this would be greatly appreciated.

Note: One of my ideas was to set off a macro when new data was entered in column C that would unlock the spreadsheet, expand the table and then re-lock the spreadsheet but I cannot seem to make this work/find the right code to expand the table without knowing the exact range.

The data starts at A3 and goes to the last row of data in column W, however there are some blanks periodically in various columns. The only column that does not have any blanks is column C.

The locked formulas are in columns L,M and N, there are other formulas that are not locked however in other columns.

There will also be situations when a macro will dump large blocks of data will be pasted in the last blank row in column A to column G so I don't know if using "new data in column C" as a trigger would work..

I hope someone can help as I feel stumped on this one.

My table name is "MF"

Thank you!



		VBA Code:
__


If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Value <> "" Then

  
        Worksheets("Master Forecast").Unprotect Password:="2150"

'Code to resize table or bring down data by 1 row??

Worksheets("Master Forecast").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True, Password:="2150"

End If
End Sub


----------



## dancer5

Hello,
I've been trying to solve the same problem with having my table auto resize to include the new rows when data is pasted into columns Q:W below the currently sized table. I tried the code above but am getting the same 1004 error. My table headers are in row 4 and I modified the code to  


		VBA Code:
__


With Me.ListObjects("table1")
            .Resize .Range(1).CurrentRegion.Offset(1).Resize(.Range(1).CurrentRegion.Rows.Count - 3)
         End With

But no luck.
Another problem I've encountered is that columns A:B need to stay unprotected.

I am new to VBA, so any help would be appreciated!


----------

