Adding a ListRow into a table of a protected worksheet

Question

I want to add data to last row in each table in each worksheet when the worksheet is protected.

I have this code in ThisWorkbook to protect the worksheets

Private Sub Workbook_Open()
    Dim wSheet As Worksheet
    For Each wSheet In Worksheets
        wSheet.Protect Password:="Secret", _
        UserInterFaceOnly:=True
    Next wSheet
End Sub

and the following code to add the data. It throws

Error 1004 "Application-defined or Object-defined error"

at the Set newrow1 = tbl.ListRows.Add when the worksheet is protected.

Sub AddDataToTable()
    Application.ScreenUpdating = False
    Dim MyValue As String
    Dim sh As Worksheet
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim ws4 As Worksheet
    Dim ws5 As Worksheet
    Set ws1 = Sheets("Setting")
    Set ws2 = Sheets("R_Buy")
    Set ws3 = Sheets("R_Sell")
    Set ws4 = Sheets("S_Buy")
    Set ws5 = Sheets("S_Sell")
    Dim tbl As ListObject
    Dim tb2 As ListObject
    Dim tb3 As ListObject
    Dim tb4 As ListObject
    Dim tb5 As ListObject
    Set tbl = ws1.ListObjects("T_Setting")
    Set tb2 = ws2.ListObjects("T_R_Buy")
    Set tb3 = ws3.ListObjects("T_R_Sell")
    Set tb4 = ws4.ListObjects("T_S_Buy")
    Set tb5 = ws5.ListObjects("T_S_Sell")
    Dim newrow1 As ListRow
    Dim newrow2 As ListRow
    Dim newrow3 As ListRow
    Dim newrow4 As ListRow
    Dim newrow5 As ListRow

    MyValue = InputBox("Add To Table, this cannot be undone")

    'check if user clicked Cancel button and, if appropriate, execute statements
    If StrPtr(MyValue) = 0 Then
        'display message box confirming that user clicked Cancel button
        MsgBox "You clicked the Cancel button"
        'check if user entered no input and, if appropriate, execute statements
    ElseIf MyValue = "" Then
        'display message box confirming that user entered no input
        MsgBox "There is no Text Input"
    Else
        Set newrow1 = tbl.ListRows.Add
        With newrow1
            .Range(1) = MyValue
        End With

        Set newrow2 = tb2.ListRows.Add
        With newrow2
            .Range(1) = MyValue
        End With

        Set newrow3 = tb3.ListRows.Add
        With newrow3
            .Range(1) = MyValue
        End With

        Set newrow4 = tb4.ListRows.Add
        With newrow4
            .Range(1) = MyValue
        End With

        Set newrow5 = tb5.ListRows.Add
        With newrow5
            .Range(1) = MyValue
        End With
    End If
    Application.ScreenUpdating = True
End Sub

Possible duplicate of Unable to add ListRow to ListObject with worksheet protected using UserInterfaceOnly:=true — Pᴇʜ

Pᴇʜ Pᴇʜ · Accepted Answer · 2018-09-05T08:16:41

That's an issue with Excel that it doesn't allow to edit tables in UserInterFaceOnly:=True mode. Unfortunately, the only workaround I've found is to unprotect before any table methods are applied and then reprotect after:

.Unprotect Password:=SHEET_PW 'unprotect sheet          
'edit table         
.Protect Password:=SHEET_PW, UserInterFaceOnly:=True 'reprotect

Additionally I suggest the following improvement to shorten your code:

Use arrays Dim tbl(1 To 5) instead of multiple variables tbl1, tbl2, tbl3, …
Or better use an array to list your worksheet names only.
Use more descriptive variable names (makes your life easier to maintain and read the code)
If your table names are always T_ followed by the worksheet name you can easily generate them out of your worksheet name.
Use a constant for your worksheet password SHEET_PW to have it stored in only one place (easier to change, prevents typos).
Use loops to do repetitive things.

So we end up with:

Option Explicit

Const SHEET_PW As String = "Secret" 'global password for protecting worksheets

Public Sub AddDataToTableImproved()
    Dim AddValue As String
    AddValue = InputBox("Add To Table, this cannot be undone")

    If StrPtr(AddValue) = 0 Then 'cancel button
        MsgBox "You clicked the Cancel button"
        Exit Sub
    ElseIf AddValue = "" Then 'no input
        MsgBox "There is no Text Input"
        Exit Sub
    End If

    Dim NewRow As ListRow

    Dim SheetNameList() As Variant
    SheetNameList = Array("Setting", "R_Buy", "R_Sell", "S_Buy", "S_Sell")

    Dim SheetName As Variant
    For Each SheetName In SheetNameList
        With ThisWorkbook.Worksheets(SheetName)
            .Unprotect Password:=SHEET_PW 'unprotect sheet

            Set NewRow = .ListObjects("T_" & SheetName).ListRows.Add
            NewRow.Range(1) = AddValue

            .Protect Password:=SHEET_PW, UserInterFaceOnly:=True 'reprotect it
        End With
    Next SheetName
End Sub

Adding a ListRow into a table of a protected worksheet

1 Answers