SOLVED

VBA preventing me from deleting or highlighting rows and columns

Copper Contributor

Hi Everyone,

 

I am using this formula (shown below) to copy all the data entered in a row from one sheet to another sheet, depending on cue words entered in a particular column. The problem I'm having now is that the sheet for which the formula belongs doesn't allow me to highlight or delete any rows and columns. In other words, when I right click on the row number or the column letter (to highlight the entire lot) and click on delete, an error pops up asking me to debug. Can anyone find the source of the problem please? Your help would be much appreciated. Thanks! I've attached a copy of the workbook to help explain.

 

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Target.Column = 4 And UCase(Target) = "SAVE" Then

Cells(Target.Row, Target.Column).EntireRow.Copy Destination:=Sheets("Saved").Range("A" & Rows.Count).End(xlUp).Offset(1)

End If

If Target.Column = 4 And UCase(Target) = "CLOSED" Then

Cells(Target.Row, Target.Column).EntireRow.Copy Destination:=Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)

End If

Application.EnableEvents = True

End Sub

2 Replies
best response confirmed by Jarvo (Copper Contributor)
Solution

@Jarvo 

If you select more than one cell (for example an entire row, Target.Value is not a single value, but an array of values, so the comparison UCase(Target) = "SAVE" is not valid.

Add the following line at the beginning of the procedure:

 

If Target.CountLarge > 1 Then Exit Sub

 

Since the rest of the code will only be executed if Target is a single cell, you can replace Cells(Target.Row, Target.Column) with Target.

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Application.EnableEvents = False
    If Target.Column = 4 And UCase(Target) = "SAVE" Then
        Target.EntireRow.Copy Destination:= _
            Sheets("Saved").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
    If Target.Column = 4 And UCase(Target) = "CLOSED" Then
        Target.EntireRow.Copy Destination:= _
            Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
    Application.EnableEvents = True
End Sub
Perfect this has solved the problem, thank you so much!
1 best response

Accepted Solutions
best response confirmed by Jarvo (Copper Contributor)
Solution

@Jarvo 

If you select more than one cell (for example an entire row, Target.Value is not a single value, but an array of values, so the comparison UCase(Target) = "SAVE" is not valid.

Add the following line at the beginning of the procedure:

 

If Target.CountLarge > 1 Then Exit Sub

 

Since the rest of the code will only be executed if Target is a single cell, you can replace Cells(Target.Row, Target.Column) with Target.

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Application.EnableEvents = False
    If Target.Column = 4 And UCase(Target) = "SAVE" Then
        Target.EntireRow.Copy Destination:= _
            Sheets("Saved").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
    If Target.Column = 4 And UCase(Target) = "CLOSED" Then
        Target.EntireRow.Copy Destination:= _
            Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
    Application.EnableEvents = True
End Sub

View solution in original post