Forum Discussion

Nishkarsh31's avatar
Nishkarsh31
Brass Contributor
Mar 14, 2023
Solved

How to expand table in a protected sheet using VBA?

I have a table with one protected column and few columns where I can add data. Since I don't want to delete any formula or rename any header by mistake. I wanna protect the sheet, but then the ta...
developer
excel
Macros and VBA
office 365
  • PeterBartholomew1's avatar
    PeterBartholomew1
    Mar 14, 2023

    HansVogelaar 

    My VBA programming is not really up to scratch, but I attempted to use an event handler to add rows one at a time.

    Sheet1

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LO As ListObject
Dim nextRow As Range
Dim n As Variant
    Set LO = ListObjects(1)
    n = LO.DataBodyRange.Rows.Count
    Set nextRow = LO.ListRows(n).Range.Offset(1)
    If Not Intersect(Target, nextRow) Is Nothing Then Add_a_Row
End Sub

    Module1

    Sub Add_a_Row()
    Application.ScreenUpdating = False
    With ActiveSheet
        .Unprotect
        .ListObjects(1).ListRows.Add
        .Protect
    End With
    Application.ScreenUpdating = True
End Sub

    I seems to work but is far from robust.

     

     

HansVogelaar's avatar
HansVogelaar
MVP
Mar 14, 2023

Nishkarsh31 

Adding 500 rows will be slow, but this should do it:

Sub Add_500_Rows()
    Dim i As Long
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    With ActiveSheet.ListObjects(1)
        For i = 1 To 500
            .ListRows.Add
        Next i
    End With
    ActiveSheet.Protect
    Application.ScreenUpdating = True
End Sub
  • PeterBartholomew1's avatar
    PeterBartholomew1
    Silver Contributor
    Mar 14, 2023

    HansVogelaar 

    My VBA programming is not really up to scratch, but I attempted to use an event handler to add rows one at a time.

    Sheet1

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LO As ListObject
Dim nextRow As Range
Dim n As Variant
    Set LO = ListObjects(1)
    n = LO.DataBodyRange.Rows.Count
    Set nextRow = LO.ListRows(n).Range.Offset(1)
    If Not Intersect(Target, nextRow) Is Nothing Then Add_a_Row
End Sub

    Module1

    Sub Add_a_Row()
    Application.ScreenUpdating = False
    With ActiveSheet
        .Unprotect
        .ListObjects(1).ListRows.Add
        .Protect
    End With
    Application.ScreenUpdating = True
End Sub

    I seems to work but is far from robust.

     

     

Resources