PDA

View Full Version : Deleting specific cells when a condition is no longer met



Serenutty
01-05-2018, 02:01 PM
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?
Thanks
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim s As String, r, rng As Range, sh As Worksheet

Set sh = Sheets("Costing")
s = "Exit from business or transfer to another role outside current BU or Function - no backfill"

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
I have been given a very clever solution by another Forum expert: to add date and time in column XX in both worksheets 1 and 2 so it has a way to identify a unique record and then delete it from sheet2. The code is below but somehow it doesn't work. The debug doesn't return any errors but nothing gets copied in sheet 2 "Costing"
I put the code in sheet 1 called "Pool". And there are no other scripts running in this workbook

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 1-5-2018 1:30 PM EST
On Error GoTo M
If Target.Count > 1 Then Exit Sub
Dim c As Range
Dim Lastrow As Long
Lastrow = Sheets("Costing").Cells(Rows.Count, "XX").End(xlUp).Row + 1
If Target.Column = 12 And Target.Value = "Exit from business or transfer to another role outside current BU or Function - no backfill" Then
Cells(Target.Row, "XX").Value = Now()
Range(Cells(Target.Row, 1), Cells(Target.Row, "H")).Copy Sheets("Costing").Cells(Lastrow, 1)
Sheets("Costing").Cells(Lastrow, "XX").Value = Now()
Else
If Target.Column = 12 And Target.Value <> "Exit from business or transfer to another role outside current BU or Function - no backfill" Then

For Each c In Sheets("Costing").Range("XX1:XX" & Lastrow)
If c.Value = Cells(Target.Row, "XX").Value Then Sheets("Costing").Rows(c.Row).Delete
Next
Cells(Target.Row, "XX").Value = ""
End If
End If
Exit Sub
M:
MsgBox "Sorry we had some type problem. Try again"
End Sub


I'd appreciate any views on how to solve this
Thanks