Re: Can you specify an Array as a Target??



Thanks for your reply Dave... this did not achieve the desired result so I
have sent to you a copy of the spread*** and some further information.

Thanks again for your assistance!

JP

"Dave Peterson" wrote:

Maybe something like this (untested):

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
dim myRngToCheck as range
dim myCell as range
set myrngtocheck = intersect(me.columns(57),target)
if myrngtocheck is nothing then exit sub

for each mycell in myrngtocheck.cells
On Error Resume Next
If UCase(mycell.Value) = "YES" Then
Application.EnableEvents = False
With me '*** that owns the code
.Range(.Cells(mycell.Row, 49), .Cells(mycell.Row, 51)).Copy
Worksheets("Demolition Package 1").Cells(mycell.Row - 4, 1) _
.PasteSpecial Paste:=xlPasteValues
end with
Application.EnableEvents = True
End If

.....


JP wrote:

I have a spreadsheet with multiple worksheets. On the Master spreadsheet I
have a column with a validation list giving users a "YES" or "NO" option. If
they select the "YES" option then it copies the data in the target,row cells
49,50,51 and pastes it into another work***. By selecting the "NO" option
it will clear the contents of those cells.

The issue that I have is that there will be up to 1000 rows to which an
individual "YES" or "NO" selection will need to be made. To make this faster
I would like to be able to click and drag the "YES" response to multiple
cells where appropriate.

What is the correction I need to make to the following code to allow this to
happen?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column <> 57 Then Exit Sub
On Error Resume Next
If UCase(Target.Value) = "YES" Then
Application.EnableEvents = False
With Active***
.Range(.Cells(Target.Row, 49), .Cells(Target.Row, 51)).Copy
Worksheets("Demolition Package 1").Cells(Target.Row - 4,
1).PasteSpecial Paste:=xlPasteValues
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
Application.CutCopyMode = False
End With
Application.EnableEvents = True
End If

--

Dave Peterson

.