Copy and Paste problems with SelectionChange VBA event

[JJC1965]

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?

 

[venkat1926]

how to check the code if the code is not given in full?

 

[JJC1965]

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
Else
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.