Home » excel » excel – Copy & paste inadvertently triggers Worksheet_Change sub

excel – Copy & paste inadvertently triggers Worksheet_Change sub

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am having problems with a “Worksheet_Change” sub that copies and pastes the whole row into a second worksheet (“Completed”) when the column “P” takes on the value “x”. It reads like this:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    Application.EnableEvents = False
    'If Cell that is edited is in column P and the value is x then
    If Target.Column = 16 And Target.Value = "x" Then
        'Define last row on completed worksheet to know where to place the row of data
        LrowCompleted = Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row
        'Copy and paste data
        Range("A" & Target.Row & ":P" & Target.Row).Copy Sheets("Completed").Range("A" & LrowCompleted + 1)
        'Delete Row from Project List
        Range("A" & Target.Row & ":P" & Target.Row).Delete xlShiftUp
    End If
    Application.EnableEvents = True
End Sub

The sub itself works fine but if I copy and paste anywhere in the worksheet, the sub is activated and the row into which I paste is send to my “Completed” sheet.

I have played around with the “if-clause” without any luck so far. E.g.:

    If Not Target.Column = 16 And Target.Value = "x" Is Nothing Then

I fear I am missing the obvious and I am grateful for any help.

Thanks and regards

PMHD

How to&Answers:

If you are concerned with muliple targets, deal with them; don’t discard them.

Private Sub Worksheet_Change(ByVal Target As Range)

  If not intersect(target, range("p:p")) is nothing then
        on error goto meh
        Application.EnableEvents = False
        dim t as range, lrc as long
        lrc = workSheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row + 1
        for each t in intersect(target, range("p:p"))
            if lcase(t.Value2) = "x" Then
                intersect(columns("A:P"), t.rows(t.row)).Copy _
                    destination:=workSheets("Completed").cells(lrc , "A")
                lrc = lrc+1
                'Delete Row from Project List
                intersect(columns("A:P"), t.rows(t.row)).Delete xlShiftUp
             end if
        next t
    End if

meh:
    Application.EnableEvents = true

end sub

Answer:

Thanks, Jeeped.

The problem arose due to Target referring to multiple cells. It was fixed by excluding cases where Target.Count > 1.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
'Exclude all cases where more than one cell is Target
If Target.Count > 1 Then

'If Cell that is edited is in column P and the value is x then
ElseIf Target.Column = 16 And Target.Value = "x" Then
    'Define last row on completed worksheet to know where to place the row of data
    LrowCompleted = Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row
    'Copy and paste data
    Range("A" & Target.Row & ":P" & Target.Row).Copy Sheets("Completed").Range("A" & LrowCompleted + 1)
    'Delete Row from Project List
    Range("A" & Target.Row & ":P" & Target.Row).Delete xlShiftUp
End If
Application.EnableEvents = True
End Sub