Worksheet_Change (Excel 2000)

[RNCIENG]

Good Morning Everyone,

One day, One day......I will get the hange of this.....I creep and crawl. Just when I think I've got it....I don't. Some of this stuff I can do on my own....the rest I'm LOST!!!

At any rate, below is some code I've been tinkering with. What I want to do is when the value in column "M" (which is a drop down list) changes to "No contact w/patient" I want the entire row to be cut and pasted to a worksheet "6 Mth Eval". I've tried many variations of the code but this is the lastest. I don't get an error but nothing happens either.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim wshSource As Worksheet, wshTarget As Worksheet
Dim rngSource As Range, rngTarget As Range

Set wshSource = Worksheets("Asthma")
Set rngSource = wshSource.Range("M65536")

Set wshTarget = Worksheets("6 Mth Eval")
Set rngTarget = wshTarget.Range("A65536").End(xlUp).Offset(1, 0).Resize(1, 15)

' If Not Intersect(Target, rngSource) Is Nothing And rngSource = "No Contact w/Patient" Then
If rngSource = "No Contact w/Patient" Then

Sheets("6 Mth Eval").Visible = True
Sheets("6 Mth Eval").Select
rngSource.Cut
rngTarget.PasteSpecial Paste:=xlPasteValues
Sheets("6 Mth Eval").Visible = False
End If

End Sub
I'm hoping one of you VBA guru's in here will show me the error of my ways.

Thanks in advance.

[RNCIENG]

Hans,

Thanks for your help and suggestion. And yes I agree with you....a much better idea....as I mentioned earlier....just creeping and crawling here!!!! The code you provided can't be used to select ALL the "No Contact w/Patient"'s can it? It only copies and deletes the current one the user is working with correct?

Also, with your code, it crashes (and closes Excel) on this line:
Intersect(Target, rngSource).Cells(1).Cells(1).EntireRow.Delete
with the error msg "Method of Delete of Object failed"

Again, thanks for your kind help and suggestions.

[HansV]

Your source range is only cell M65536.
You don't check if it is within the target range.
You should not use the SelectionChange event, but the Change event, if you want to do this using worksheet events. SelectionChange occurs when the user moves to another cell, Change when the user modifies the contents of a cell.
You cannot combine Cut and PasteSpecial; you must Copy first, then PasteSpecial, then delete the source.
You're only cutting one cell instead of a whole row, then pasting it into an area 15 cells wide.

Here is modified code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wshSource As Worksheet, wshTarget As Worksheet
Dim rngSource As Range, rngTarget As Range

Set wshSource = Worksheets("Asthma")
Set rngSource = wshSource.Range("M:M")

Set wshTarget = Worksheets("6 Mth Eval")
Set rngTarget = wshTarget.Range("A65536").End(xlUp).Offset(1, 0)

If Not Intersect(Target, rngSource) Is Nothing Then
If Intersect(Target, rngSource).Cells(1) = "No Contact w/Patient" Then
Intersect(Target, rngSource).Cells(1).EntireRow.Copy ' corrected
rngTarget.PasteSpecial Paste:=xlPasteValues
Intersect(Target, rngSource).Cells(1).EntireRow.Delete ' corrected
End If
End If
End Sub

But I doubt whether the users will like this. As soon as they type "No Contact w/Patient" in a cell in column M, the entire row disappears to the hidden sheet 6 Mth Eval. The user has no chance of correcting anything. I would prefer creating a command button that calls a macro to move all rows that contain "No Contact w/Patient" in column M.

[HansV]

The two instances of .Cells(1).Cells(1) should be .Cells(1). Sorry about that, don't know how that crept in there. If you want to process all cells with "No Contact w/Patient" in column M, I would definitely use standard macro instead of a worksheet event. You can call the macro from a command button, or from a custom toolbar button.

Sub ProcessColumnM()
Dim wshSource As Worksheet, wshTarget As Worksheet
Dim lngSourceRow As Long, lngMaxRow As Long
Dim lngTargetRow As Long

Set wshSource = Worksheets("Asthma")
Set wshTarget = Worksheets("6 Mth Eval")

lngMaxRow = wshSource.Range("M65536").End(xlUp).Row
lngTargetRow = wshTarget.Range("A65536").End(xlUp).Row

For lngSourceRow = lngMaxRow To 1 Step -1
If wshSource.Range("M" & lngSourceRow) = "No Contact w/Patient" Then
wshSource.Range("M" & lngSourceRow).EntireRow.Copy
lngTargetRow = lngTargetRow + 1
wshTarget.Range("A" & lngTargetRow).PasteSpecial Paste:=xlPasteValues
wshSource.Range("M" & lngSourceRow).EntireRow.Delete
End If
Next lngSourceRow
End Sub

[RNCIENG]

PERFECT!!!!!!!!!!!!!!!!! PERFECT!!!!!!!!!!!!!!!!!!!!!!

Thanks so much......works so nicely.............and I was so off base....would never have gotten it......THANK YOU !!!!!!!!!!!!!!!!!!