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

SaraWitch

Active Member
Joined
Sep 29, 2015
Messages
322
Office Version
  1. 365
Platform
  1. Windows
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).

VBA Code:
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 :)
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
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.

VBA Code:
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

VBA Code:
    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)

VBA Code:
   Worksheets("EBC EA Leavers").Protect Password:="myPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
   Worksheets("EBC EA Leavers").EnableSelection = xlUnlockedCells
 
Upvote 1
Just copy the data across as values

VBA Code:
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
 
Upvote 1
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
Rich (BB code):
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)
 
Last edited:
Upvote 1
If the value you are watching for changes is a formula and not a hard-coded value, you cannot use a Worksheet_Change event procedure to track.
Worksheet_Change procedure only fire upon MANUAL updates of cells, not changes due to formulas.

There is a Worksheet_Calculate event procedure, but it works a bit differently. It fires whenever any cell on your sheet is re-calculated (i.e. via formula).
However, the big caveat is that unlike Worksheet_Change, Excel cannot tell/identify which cell's value was re-calculated. All it can tell you is that some cell somewhere on the sheet was re-calculated.
So it doesn't sound like that will work for you, in this case.

You may need to come about this a bit differently.
What exactly is the formula in column U?
We may need to watch the cells that you manually update that affect column U instead. But we would need to know more detail about it before we can make that determination.
 
Upvote 0
Thank you, @Joe4.

The code in column U is:
Excel Formula:
=IF(T8="",0,IF(CR8>0,CS10,IF(AR8>0,AS8,IF)SE8>0,AF8))))

What I could do (which may actually work better for reporting purposes because I don't want the row to move if the date is not prior to today), is build into the code to unprotect U8 when a date is showing so the user can physically type the date when the row needs to move...? And that code is stumping me!
 
Upvote 0
That is not even a valid formula.
Rich (BB code):
=IF(T8="",0,IF(CR8>0,CS10,IF(AR8>0,AS8,IF)SE8>0,AF8))))
Here is some advice - don't try to manually type your working formulas or VBA code - use Copy/Paste. That will eliminate any chance of making typos.

It would be helpful to see what this data looks like, and what it might be returning.
Could the value in column U return any date that is NOT the current date, because I do not see anything in your original code checking the value of the date on column U?

I think we need to see/have a better understanding of the data you are working with, and what it might return.
 
Upvote 0
This workbook is a bit of a beast, but here it is! I've done a bit extra work on it and there now seems to be a code that keeps returning an error (I am trying to create drop down list but show different values in columns AM, AZ, BM, BZ, CM, CZ - I will log this separately).

EA Placements Manager

Sheet EBC "EA Placements (2)" is my working sheet.
 
Upvote 0
I do not have the ability to download files from my current location.

I've done a bit extra work on it and there now seems to be a code that keeps returning an error
So does that mean the original question you had in this thread has been solved, but you have a different question now?
 
Upvote 0
Sorry, @Joe4 - no my original question has not been solved. I'm trying to pull some data out but Xl2bb but it's crashing Excel! I shall reboot and try with a smaller section, if that would help...?
 
Upvote 0

Forum statistics

Threads
1,216,045
Messages
6,128,484
Members
449,455
Latest member
jesski

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top