Ok, I see what you're doing. Don't call the Unprotect in the standard module routines, those which call the userforms. Instead, do it when you touch the grid.
I made three adjustments. Two were for the protection bit, one was a bug in my earlier code - a scenario where a newly added row wouldn't get a proper index/row value and you'd get an error. You would see this scenario if the Table didn't have any blank rows. I have fixed in the below code.
1. In 'Protection' module, add these routines. They give you a targeted approach, rather than blanketing every sheet with protect/unprotect calls.
2. In 'mAppointment' remove your protect/unprotect calls.Public Function ProtectSheet( _ ByVal Sheet As Worksheet, _ Optional ByVal Password As String _ ) As Boolean If Sheet.ProtectContents Then ProtectSheet = True Exit Function End If On Error Resume Next Sheet.Protect Password On Error GoTo 0 If Sheet.ProtectContents Then ProtectSheet = True End If End Function Public Function UnprotectSheet( _ ByVal Sheet As Worksheet, _ Optional ByVal Password As String _ ) As Boolean If Sheet.ProtectContents = False Then UnprotectSheet = True Exit Function End If On Error Resume Next Sheet.UnProtect Password On Error GoTo 0 If Sheet.ProtectContents = False Then UnprotectSheet = True End If End Function
3. In 'fAppointment' remove your protect/unprotect calls. Adjust your 'OkButton' routine to the below code.
Private Sub OkButton_Click() Dim Table As ListObject Dim DatePart As Date Dim TimePart As Date Dim Index As Long On Error Resume Next DatePart = CDate(Me.tDate.Value) TimePart = CDate(Me.tTime.Value) On Error GoTo 0 If DatePart = 0 Or TimePart = 0 Then MsgBox "Please enter a date and time.", vbExclamation + vbOKOnly, "Date/Time" Exit Sub End If If Me.tAppointment.Value = vbNullString Then MsgBox "Please enter an appointment text.", vbExclamation + vbOKOnly, "Appointment" Exit Sub End If Set Table = ThisWorkbook.Worksheets("Calendar").ListObjects("Table2") UnprotectSheet Table.Parent If Me.NewAppointment Then If Table.DataBodyRange Is Nothing Then Table.ListRows.Add Me.AppointmentIndex = 1 Else For Index = 1 To Table.ListRows.Count If WorksheetFunction.CountA(Table.DataBodyRange(Index, 1).Resize(1, 3)) = 0 Then Me.AppointmentIndex = Index Exit For End If Next Index End If If Index > Table.ListRows.Count Then Table.ListRows.Add Me.AppointmentIndex = Index End If Else Index = Me.AppointmentIndex End If If Me.AppointmentIndex > 0 Then Table.DataBodyRange(Me.AppointmentIndex, 1).Value = Format(TimePart, "h:mm AM/PM") Table.DataBodyRange(Me.AppointmentIndex, 2).Value = Me.tAppointment.Value Table.DataBodyRange(Me.AppointmentIndex, 3).Value = Format(DatePart, "mm/dd/yyyy") Unload Me Else MsgBox "Something went wrong.", vbExclamation + vbOKOnly, "Whoops!" End If ProtectSheet Table.Parent End Sub




Reply With Quote