Copy and Paste problems with SelectionChange VBA event


New Member
Mar 29, 2012
I have build a workbook for pricing product. The VBA behind the worksheet uses the SeletionChange event to up date the pricing when new data is entered. This has worked well, except that I now need to delete some data before the pricing is updated. I added a couple of lines of code to delete the data in question into my existing Selection Change event, but the new code has caused the lose of any copy and paste function on the work sheet. Do I need to move my code to Delete to a separate function and call it? Or is there a different path?

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.


New Member
Mar 29, 2012
Here my code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Room As Range
Dim Items As Range
Dim iTotalRows As Integer

Dim V As String
Dim rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
Dim r As Long
Dim Rg As Range
Dim x As String
Dim y As String
Dim i As Long, t As Range, coltoSearch As String

V = ThisWorkbook.Names("IDNUMBER").RefersToLocal
iTotalRows = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
Set Room = ActiveSheet.Range("B" & (Right(V, 1)) & ":m" & iTotalRows)
sourceCol2 = 3
coltoSearch = "D"

Application.ScreenUpdating = False

For r = 1 To iTotalRows
Set Rg = Room.Cells(r, 1)

'If Room.Cells(r, 1) > "" Then
'Room.Cells(r, 9).ClearContents
' Room.Cells(r, 10).ClearContents
' End If

If IsNumber(Rg) Then
x = Rg.Address

If y = "" Then
For i = Right(x, Len(x) - InStr(2, x, "$")) To Range(coltoSearch & Rows.Count).End(xlUp).Row + 1
Set t = Range(coltoSearch & i)

If Len(t.Value) = 0 Then
y = t.Address
End If
If y <> "" Then Exit For
Next i
Set Items = Range(x & ":" & y)
Dim Z As Integer
For Each Price In Items.Rows
Z = Z + 1
If Items.Rows.Cells(Z, 1).Offset(1, 7).Value = "" Or Items.Rows.Cells(Z, 1).Offset(1, 16).Value = "" Then
Items.Rows.Cells(Z, 1).Offset(1, 8).Value = 0
Items.Rows.Cells(Z, 1).Offset(1, 9).Value = 0
Items.Rows.Cells(Z, 1).Offset(1, 8).Value = Items.Rows.Cells(1, 1) * Items.Rows.Cells(Z, 1).Offset(1, 7).Value
Items.Rows.Cells(Z, 1).Offset(1, 9).Value = Items.Rows.Cells(1, 1) * Items.Rows.Cells(Z, 1).Offset(1, 16).Value
End If
Next Price
Z = 0
End If
End If

y = ""

Next r
Set Rg = Nothing

Application.ScreenUpdating = True

End Sub

The code work fine with the "delete" section blocked. What I trying to do is delete the values in column 9 & 10 in the Room range if the cell Room.Cell(r,1) is blank.

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics