Autodelete a row from protected sheet and move to another protected sheet based on date

[SaraWitch]

Hello peeps,

In a protected sheet ("Placements"), I have a formula in column U that calculates a date from a range of other cells. When a date is populated, I want the row to automatically delete and paste into another protected sheet ("Leavers"). I think I'm almost there with the formula below but know I have to change the <> in line 4 (I've tried some date text but it doesn't work).

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ("password")
    Dim NextRow As Long
    If Target.Column <> 21 Then Exit Sub
    Application.EnableEvents = False
    With Sheets("Leavers")
        NextRow = .Cells(Rows.Count, 8).End(xlUp).Row + 1
        Target.EntireRow.Copy Destination:=.Cells(NextRow, 1)
        Target.EntireRow.Delete
    End With
    Application.EnableEvents = True
ActiveSheet.Protect ("password")
End Sub

Any help would be gratefully received

 

[SaraWitch]

I shall reboot and try with a smaller section, if that would help...?

That is a very odd post for your first post when you weren't the one to post the original question...
Not really sure if you are trying to help or asking for help.

Me too!

 

[MARK858]

And is it further possible to re-protect the sheets with the same password the row/s have moved?

If you are just using standard protection (i.e. you haven't changed any of the options when you protected the sheets then you just do it the same way as you have done in the original post.

Worksheets("EBC EA Leavers").Unprotect "YourPassword1"
Worksheets("EBC EA Placements").Unprotect "YourPassword2"
 
' Rest of your code

Worksheets("EBC EA Leavers").Protect "YourPassword1"
Worksheets("EBC EA Placements").Protect "YourPassword2"

If you have changed any of the protection options then the easiest thing to do is use the macro recorder when setting the protection manually and it will produce the code you need... something like

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    ActiveSheet.EnableSelection = xlUnlockedCells

then just replace ActiveSheet with the relevant sheet like the below (you'll have to add the Password:="myPassword", as it won't record your password)

   Worksheets("EBC EA Leavers").Protect Password:="myPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
   Worksheets("EBC EA Leavers").EnableSelection = xlUnlockedCells

 

[SaraWitch]

Amazing! I can't tell you what a difference this will make to the management of the workbook!!

Thank you so much, @MARK858

(I wonder when you get a moment, you could remove the link to the workbook in your post #37... ...thank you again!)

 

[MARK858]

(I wonder when you get a moment, you could remove the link to the workbook in your post #37... ...thank you again!)

I will on this occasion but in future please desensitize any sensitive data before posting it on a public forum

From post 31

Before uploading
1) make sure you sanitize any sensitive data

 

[SaraWitch]

Thank you (there was no sensitive data - I was just being cautionary).

Again, I appreciate all your help

 

[SaraWitch]

So sorry, @MARK858 - is there a way that when a row is moved it matches the conditional formatting in the new sheet (which is slightly different to the sheet from which the row is being moved)? (Every time I think I've thought of everything! )

 

[MARK858]

Just copy the data across as values

Sub Move_Row_to_Leavers_Sheet()
Dim lr As Long, i As Long
 
Application.ScreenUpdating = False
 
  
Worksheets("EBC EA Leavers").Unprotect "YourPassword1"
Worksheets("EBC EA Placements").Unprotect "YourPassword2"
 
    For i = Sheets("EBC EA Placements").Columns(3).Find("*", , xlValues, , xlByRows, xlPrevious).Row To 8 Step -1
     
        If Sheets("EBC EA Placements").Cells(i, 22).Value = "Left" Then
         
         
            With Worksheets("EBC EA Leavers")
                lr = .Columns(3).Find("*", , xlValues, , xlByRows, xlPrevious).Row
             
                If lr < 8 Then
                    Sheets("EBC EA Placements").Cells(i, 22).EntireRow.Copy
                    .Cells(8, 1).PasteSpecial xlValues
                    Sheets("EBC EA Placements").Cells(i, 22).EntireRow.Delete
                Else
                    Sheets("EBC EA Placements").Cells(i, 22).EntireRow.Copy
                    .Cells(lr + 1, 1).PasteSpecial xlValues
                    Sheets("EBC EA Placements").Cells(i, 22).EntireRow.Delete
                End If
            
               Application.CutCopyMode = False
             
            End With
    
       End If
 
    Next

 
Worksheets("EBC EA Leavers").Protect "YourPassword1"
Worksheets("EBC EA Placements").Protect "YourPassword2"
 
Application.ScreenUpdating = True

End Sub

 

[SaraWitch]

Amazing! Thank you, @MARK858 - really appreciate it!

 

[SaraWitch]

Hi @MARK858.

Your wonderful code moves a row to another sheet beautifully. I was just wondering if there's a way to move it to the bottom of the list, rather than row 8, which would be at the top every time. There are many empty rows (but with formulas) in the Leaver's sheet but I would like the moved row to go in the next available row (say in the next blank row in column D) - is this possible at all?

 

[MARK858]

There are many empty rows (but with formulas)

They are either empty rows or they have formulas, they can't be both

I was just wondering if there's a way to move it to the bottom of the list, rather than row 8

The code I posted looks for the last cell with data in column C, if that row is less than row 8 it pastes in row 8. If the last row with values is row is greater than or equal to row 8 then it pastes in the next row after the last row with values in column C, if you want Column D then change the 3 to 4

lr = .Columns(3).Find

If you want something else then you need to make your description clearer (especially about the formulas and where you want the last row in relation to the formulas and the results they return)