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!

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

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]

How about

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

         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]

Ok, how about

         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]

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.