Deleting specific cells when a condition is no longer met

[Serenutty]

Hello,

I have this coding below, which works really well, by automatically copying and pasting specific cells from worksheet1 onto worksheet2 when specific words are chosen in worksheet1 cell L from a drop down menu. The problem I have is that once the cells are pasted onto worksheet2, they won’t be deleted if the choice on dropdown menu in worksheet1 cell L changes. Any way to solve this? I thought of adding a subroutine to check for duplicates and delete one as no 2 records will be the same but I have no clue how to add this. Hopefully someone will be able to help me.
Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim s As String, r, rng As Range, sh As Worksheet
    
    Set sh = Sheets("Decision")
    s = "Exit from this plan and entering another"
    
    If Target.Count > 1 Then Exit Sub
    
    If Target.Column = 12 Then
        If Target = s Then
            r = Target.Row
            Set rng = Range("A" & r & ":H" & r)
            With sh
                rng.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
        End If
    End If
    
End Sub

 

[My Aswer Is This]

If you wanted the row in sheet one copied to the same row on sheet two that would have been a lot easier

The script would say something like this this:
If row 20 column L = "Yes" copy Sheet one row 20 to sheet two row 20 else Sheet(2) Row(20) delete.
We would not need to use date and time.

 

[Serenutty]

I didn't realise there were formulas when I started this.
But copying to the first available row seems logical because it will never be th esame amounts of rows in sheet 2 since only the ones that meet the condition are copied.
Is there a way to preserve the row it belongs in sheet 1 when copying to sheet 2? maybe coping those cells next to XX and making reference to them there? None will ever look at the formula as long as the value is correct
What do you think?

 

[Serenutty]

But then there would be empty rows in sheet 2 for those records that are missing due to not meeting the criteria in sheet 1 for being copied.
Nevertheless, in the other forum, I posted your code and mentioned not keeping a link between rows, therefore formula values being wrong and someone came up with this solution.
I'm hoping you will appreciate the method of solving it, not that you are not capable, as I'm sure you are, but as you say there's a lot still to be learned then here is a tip. And in fairness the other person had my complete workbook to play with.

[Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo M
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
CopyFrom = "Pool"
CopyTo = "Costing"
LookFor = "Not exiting"
Sheets(CopyFrom).Activate

If Target.Column = 12 Then
y = Target.Row
Cells(y, 13).Formula = "=if(L" & y & "=""Not exiting"",0,1)"
Cells(y, 15).Formula = "=SUMIF(Costing!XX:XX,Pool!XX" & y & ",Costing!Y:Y)"
Cells(y, 16).Formula = "=SUMIF(Costing!XX:XX,Pool!XX" & y & ",Costing!P:P)"
Lastrow = Sheets(CopyTo).Cells(Rows.Count, "A").End(xlUp).Row + 1
If Target.Value = LookFor Then
xx = Sheets(CopyFrom).Cells(y, "XX")
With Sheets(CopyTo)
For c = Lastrow To 2 Step -1
If .Cells(c, "XX") = xx Then
.Rows(c).Delete
c = -1
End If
Next c
End With
Else
With Sheets(CopyFrom)
.Cells(y, "XX") = Now()
.Range(.Cells(y, 1), .Cells(y, "H")).Copy Sheets(CopyTo).Cells(Lastrow, 1)
End With
Sheets(CopyTo).Cells(Lastrow, "XX") = Now()
End If
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "Sorry we had some type problem. Try again"
End Sub
]

so I thank you greatly because without you I would have never solved this problem.

I hope to find you here again when I post my next problem

 

[My Aswer Is This]

Well glad you found a answer on another forum. Take care

But then there would be empty rows in sheet 2 for those records that are missing due to not meeting the criteria in sheet 1 for being copied.
Nevertheless, in the other forum, I posted your code and mentioned not keeping a link between rows, therefore formula values being wrong and someone came up with this solution.
I'm hoping you will appreciate the method of solving it, not that you are not capable, as I'm sure you are, but as you say there's a lot still to be learned then here is a tip. And in fairness the other person had my complete workbook to play with.

[Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo M
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
CopyFrom = "Pool"
CopyTo = "Costing"
LookFor = "Not exiting"
Sheets(CopyFrom).Activate

If Target.Column = 12 Then
y = Target.Row
Cells(y, 13).Formula = "=if(L" & y & "=""Not exiting"",0,1)"
Cells(y, 15).Formula = "=SUMIF(Costing!XX:XX,Pool!XX" & y & ",Costing!Y:Y)"
Cells(y, 16).Formula = "=SUMIF(Costing!XX:XX,Pool!XX" & y & ",Costing!P:P)"
Lastrow = Sheets(CopyTo).Cells(Rows.Count, "A").End(xlUp).Row + 1
If Target.Value = LookFor Then
xx = Sheets(CopyFrom).Cells(y, "XX")
With Sheets(CopyTo)
For c = Lastrow To 2 Step -1
If .Cells(c, "XX") = xx Then
.Rows(c).Delete
c = -1
End If
Next c
End With
Else
With Sheets(CopyFrom)
.Cells(y, "XX") = Now()
.Range(.Cells(y, 1), .Cells(y, "H")).Copy Sheets(CopyTo).Cells(Lastrow, 1)
End With
Sheets(CopyTo).Cells(Lastrow, "XX") = Now()
End If
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "Sorry we had some type problem. Try again"
End Sub
]

so I thank you greatly because without you I would have never solved this problem.

I hope to find you here again when I post my next problem

 

[Serenutty]

Oh no, that was only the reference linking both cells in both sheets for keeping the formulas. The main problem was solved by you! You made the spreadsheet work!
I sent you the final code because I thought it was very clever the way vletm had created the formulas in the code rather than having them in sheet 1.
You guys are excellent
Thank you so much

 

[My Aswer Is This]

Hey it does not bother me I'm just here to help people.
This last script your now showing is part of which I made and a large portion has been made I guess by someone on another Forum.

There are always 20 different ways to do things with Excel.

 

[Serenutty]

Glad you are not offended. Yes, it really was a team effort but it was based on your code and the changes were based on your code and due to the formulas, which you never knew about. Do you think the final code is neat, though? See below
I was constrained by time and all of this is way higher than my capabilities even when I studied a bit a few years back. I have not needed it for work and I've forgotten everything. I need to start with the basics again. Any tips on a good site where the explanations are simple and good? I need a mentor! ha ha
PS - do you ever sleep?

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo M
    If Target.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False
        CopyFrom = "Pool"
        CopyTo = "Costing"
        LookFor = "Not exiting"
        Sheets(CopyFrom).Activate
    
    If Target.Column = 12 Then
        y = Target.Row
        Cells(y, 13).Formula = "=if(L" & y & "=""Not exiting"",0,1)"
        Cells(y, 15).Formula = "=SUMIF(Costing!XX:XX,Pool!XX" & y & ",Costing!Y:Y)"
        Cells(y, 16).Formula = "=SUMIF(Costing!XX:XX,Pool!XX" & y & ",Costing!P:P)"
        Lastrow = Sheets(CopyTo).Cells(Rows.Count, "A").End(xlUp).Row + 1
        If Target.Value = LookFor Then
            xx = Sheets(CopyFrom).Cells(y, "XX")
            With Sheets(CopyTo)
                For c = Lastrow To 2 Step -1
                    If .Cells(c, "XX") = xx Then
                        .Rows(c).Delete
                        c = -1
                    End If
                Next c
            End With
        Else
            With Sheets(CopyFrom)
                T1 = Now
                .Cells(y, "XX") = T1
                .Range(.Cells(y, 1), .Cells(y, "H")).Copy Sheets(CopyTo).Cells(Lastrow, 1)
            End With
            Sheets(CopyTo).Cells(Lastrow, "XX") = T1
        End If
    End If
    Application.ScreenUpdating = True
    Exit Sub
M:
    MsgBox "Sorry we had some type problem. Try again"
End Sub

 

[My Aswer Is This]

I'm not sure I would call it neat. Like I said before every one likes to write script differently. I never claim to write the best scripts. There are some on the forum who have used Excel for their jobs for 20 years or more and have gone to specific schools to learn more and more. I can be sure someone can look at this script and say here is another way. Now I still do not know what the entire object of this script is but I guess I really do not need to know. I'm glad you like your new script and think it's neat.

 

[Serenutty]

Oh yes the possibilities are endless thats why the learning never ends.
I think the solutions for the problem are quite neat, like having Now() as unique identifier or creating the formula with the row
I must confess, any program that works and it's not 3 pages long looks good to me
I'm not entirely sure what it does either but it's supposed to calculate savings and cost for either of the 2 choices in column L
Thanks for your help because you save my sanity with your patience

 

[My Aswer Is This]

Always be sure a keep backups of your files. And if needed keep them offsite. I got my first computer Job while in the United States Air Force. Rewriting formulas and scripts after users erased all the formulas on their spreadsheet. They had to result to using hand held calculators to do their work till I arrived and rewrote all the formulas and scripts. When they erased them all the second time I learned quickly to keep backups where users could not find my backups. And thinking you can lock sheets and cells to stop this is hopeful thinking.