Unable to use Userform when Worksheet is Protected

[Krosis]

Hi,

Im looking to protect a worksheet and only allow Data input via userform. When I Password Protect the worksheet I get a debug error when trying to submit. I have had a look online and it seems I need some code to allow the userform to work while the worksheet is protected but everything iv tried hasnt worked. Im new to all this so Im not sure which code would be effected or needs editting but my guess would be the submit button? I have linked it below but please let me know if you need anymore information. Thanks!

Private Sub SubmitButton_Click()

Dim tbl As ListObject
Dim Ws As Worksheet
Dim lrow As Range
Dim lrow2 As Long

Set tbl = Sheets("Task_Check").ListObjects("Table1")

    If tbl.ListRows.Count > 0 Then

        Set lrow = tbl.ListRows(tbl.ListRows.Count).Range
        For col = 1 To lrow.Columns.Count
            If Trim(CStr(lrow.Cells(1, col).Value)) <> "" Then
                tbl.ListRows.Add
                Exit For
            End If
        Next
    End If

    lrow2 = tbl.ListRows.Count

     tbl.DataBodyRange(lrow2, 1).Value = DateBox.Value
     tbl.DataBodyRange(lrow2, 2).Value = CheckerBox.Value
     tbl.DataBodyRange(lrow2, 3).Value = CaseworkerBox.Value
     tbl.DataBodyRange(lrow2, 4).Value = TeamBox.Value
     tbl.DataBodyRange(lrow2, 5).Value = OutcomeBox.Value
     tbl.DataBodyRange(lrow2, 6).Value = TaskIDBox.Value
     If Len(FeedbackBox.Value) Then tbl.DataBodyRange(lrow2, 7).Formula = "=HYPERLINK(""" & FeedbackBox.Value & """,""Feedback"")"
     tbl.DataBodyRange(lrow2, 8).Value = CommentsBox.Value
     
Unload Me
 
End Sub

 

[Osvaldo Palmeiro]

Hi.
Please, try after adding the red line as below.

Set tbl = Sheets("Task_Check").ListObjects("Table1")
Sheets("Task_Check").Protect "YourPasswordGoesHere", UserInterFaceOnly:=True
If tbl.ListRows.Count > 0 Then

 

[Krosis]

Hi.
Please, try after adding the red line as below.

Set tbl = Sheets("Task_Check").ListObjects("Table1")
Sheets("Task_Check").Protect "YourPasswordGoesHere", UserInterFaceOnly:=True
If tbl.ListRows.Count > 0 Then

Hi Osvaldo,

Thank you for the suggestion. Tried the above and I am getting Run-time error: "1004": - Table feature aren't available because the sheet is protected. Might be a stupid question but am I meant to Protect the sheet via Review tab?

Iv highlighted the code im getting the error on below.

Private Sub SubmitButton_Click()

Dim tbl As ListObject
Dim ws As Worksheet
Dim lrow As Range
Dim lrow2 As Long


Set tbl = Sheets("Task_Check").ListObjects("Table1")
Sheets("Task_Check").Protect "Apples", UserInterFaceOnly:=True

    If tbl.ListRows.Count > 0 Then

        Set lrow = tbl.ListRows(tbl.ListRows.Count).Range
        For col = 1 To lrow.Columns.Count
            If Trim(CStr(lrow.Cells(1, col).Value)) <> "" Then
                [B]tbl.ListRows.Add <------- Highlighted in Yellow[/B]
                Exit For
            End If
        Next
    End If

    lrow2 = tbl.ListRows.Count

     tbl.DataBodyRange(lrow2, 1).Value = DateBox.Value
     tbl.DataBodyRange(lrow2, 2).Value = CheckerBox.Value
     tbl.DataBodyRange(lrow2, 3).Value = CaseworkerBox.Value
     tbl.DataBodyRange(lrow2, 4).Value = TeamBox.Value
     tbl.DataBodyRange(lrow2, 5).Value = OutcomeBox.Value
     tbl.DataBodyRange(lrow2, 6).Value = TaskIDBox.Value
     If Len(FeedbackBox.Value) Then tbl.DataBodyRange(lrow2, 7).Formula = "=HYPERLINK(""" & FeedbackBox.Value & """,""Feedback"")"
     tbl.DataBodyRange(lrow2, 8).Value = CommentsBox.Value
Unload Me
 
End Sub

 

[Krosis]

Found a ref online which uses .Unprotect password and .Protect password which is all I need. Still open to suggestions in general as im looking to improve my knowledge for future projects. Thanks for the advice so far!

 

[Osvaldo Palmeiro]

Hi.
Yes, it seems not to bem reliable for 100% the cases.

Unprotect and then Protect should be a solution.

Take a look at the thread below.

post #9
Insert Copied Rows in protected Sheet. Help