Copy and Paste problems with SelectionChange VBA event

JJC1965

New Member
Joined
Mar 29, 2012
Messages
28
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.

JJC1965

New Member
Joined
Mar 29, 2012
Messages
28
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,365
Messages
5,444,032
Members
405,262
Latest member
palash1010

This Week's Hot Topics

Top