excelvba

Can a destination table be unprotected and then protected with the new data entered in it?


I would like to unprotect my destination worksheet run a code from source worksheet then protect the destination worksheet. Source worksheet is an unprotected sheet with four tables. When a date is added into a cell on any of the tables in the source worksheet, it is supposed to copy all the data in that table row and move to a table in destination worksheet, then delete the source worksheet row. The destination worksheet table is one I would like to have protected. I am aware that in order for this to work, the destination worksheet has to be unprotected, the code can fire, then it can be protected again. I cannot get the code to run properly. Either it doesn't unprotect, or it does but doesn't protect the added data in the destination worksheet.

Can the destination sheet be unprotected, the sub performed to move the rows and then lock all the table rows, then protect the destination sheet?

I tried to record a macro that would unprotect the sheet, and a second one to protect the sheet. I tried to add each macro to the body of the sub I am trying to run, and it won't work. Here is the sub without the added macro:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range, v, ws As Worksheet, rngDel As Range
    Dim tblSrc As ListObject, tblDest As ListObject, tName
    
    'the table to append to (I converted your range to a table and named it)
    Set tblDest = ThisWorkbook.Worksheets("Revoked Master List").ListObjects("RevokedMaster")
    
    'loop over the possible source tables
    For Each tName In Array("Table15", "Table16", "Table17", "Table18")
        
        Set tblSrc = Me.ListObjects(tName) 'get the table
    
        'has a change occurred in the "RevokeDate" column?
        Set rng = Application.Intersect(Target, _
                  tblSrc.ListColumns("Date Revoked").DataBodyRange)
    
        If Not rng Is Nothing Then 'any change(s) in that column?
    
            On Error GoTo haveError 'make sure events are not left disabled if there's an error
            Application.ScreenUpdating = False
            Application.EnableEvents = False
        Call Macro1 'unprotect worksheet             
            For Each c In rng.Cells       'handling multi-cell updates
                If IsDate(c.Value) Then   'cell has date ?
                    Application.Intersect(c.EntireRow, tblSrc.DataBodyRange).Copy _
                       tblDest.ListRows.Add().Range
                    BuildRange rngDel, c 'add cell to "delete" range
                End If
            Next c
            'any copied rows to delete?
            If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
            Set rngDel = Nothing
            'Exit For 'likely only one table got updated?
        
        End If ' any changed cells to process
    Next tName 'next possible source table
    

haveError:
    If Err <> 0 Then Debug.Print Err.Description

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
    Call Macro2 'protect worksheet
'Add range `rngAdd` to range `rngTot`
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Subtype here

Solution

  • Something like this maybe:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Const PASSWD As String = "password"
        Dim rng As Range, c As Range, v, ws As Worksheet, rngDel As Range
        Dim tblSrc As ListObject, tblDest As ListObject, tName
        Dim unProt As Boolean
        
        'the table to append to (I converted your range to a table and named it)
        Set tblDest = ThisWorkbook.Worksheets("Revoked Master List").ListObjects("RevokedMaster")
        
        'loop over the possible source tables
        For Each tName In Array("Table15", "Table16", "Table17", "Table18")
            
            Set tblSrc = Me.ListObjects(tName) 'get the table
        
            'has a change occurred in the "RevokeDate" column?
            Set rng = Application.Intersect(Target, _
                      tblSrc.ListColumns("Date Revoked").DataBodyRange)
        
            If Not rng Is Nothing Then 'any change(s) in that column?
        
                'On Error GoTo haveError 'make sure events are not left disabled if there's an error
                Application.ScreenUpdating = False
                Application.EnableEvents = False
                         
                For Each c In rng.Cells       'handling multi-cell updates
                    If IsDate(c.Value) Then   'cell has date ?
                        If Not unProt Then    'need to unprotect destination worksheet?
                            tblDest.Parent.Unprotect Password:=PASSWD
                            unProt = True     'set unprotected flag
                        End If
                        Application.Intersect(c.EntireRow, tblSrc.DataBodyRange).Copy _
                           tblDest.ListRows.Add().Range
                        BuildRange rngDel, c 'add cell to "delete" range
                    End If
                Next c
            End If ' any changed cells to process
        Next tName 'next possible source table
        
        '### any copied rows to delete?  Don't delete until all rows are copied
        If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
        
    
    haveError:
        If Err <> 0 Then Debug.Print Err.Description
        If unProt Then
            tblDest.Range.Locked = True  '### make sure table cells are locked
            tblDest.Parent.Protect Password:=PASSWD
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End Sub