An alternative to Target.EntireRow

  • Thread starter Thread starter KevHardy
  • Start date Start date
K

KevHardy

Hi, I have a piece of code which copy/deletes a row of data from sheet 1 to
sheet 2 when a cell value changes to "Y" which works perfectly.
The problem is I want to repeat this code on sheet 2 to delete/copy to sheet
3 in a similar way but because it uses Target.EntireRow copying from sheet 1
to sheet 2 overwrites the validation on the end cell of sheet 2 which
prevents the code for copy/delete to sheet 3 from executing (hope that makes
sense).
Is there an alternative to Target.EntireRow which will let me stipulate the
columns (i.e. A to I)? The row changes each time.
Thanks
Kev
 
In the future you need to post your code along with an specific explanation
of what the problem is and what you need it to do. I think you want to copy
Cols. A thru Cols. I from Sheet2 to Sheet3, right?

You can your the Row property of the Target.

Range(Cells(Target.Row, "A"),Cells(Target.Row, "I"))

Hope this helps! If so, let me know, click "YES" below.
 
Hi Ryan, sorry. here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "J:J"
Dim cell As Range
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Target.EntireRow
Set rng3 = Target.Cells
Set rng2 = Worksheets("Outcomes").Cells _
(Rows.Count, 1).End(xlUp).Offset(1, 0)
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
If Target.Value <> "" Then
With rng1
.Copy Destination:=rng2
.Delete Shift:=xlUp
End With
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub

I think (?) my problem stems from the line 'Set rng1 = Target.EntireRow'

Instead of copying the entire row to the next available empty row in
"Outcomes" I want to just copy the columns A to I from the relevant row
(which will change each time).
 
One way:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Const WS_RANGE As String = "J:J"
Dim rng1 As Range
Dim rng2 As Range

If Target.Cells.Count > 1 Then
Exit Sub 'single cell at a time
End If

If Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Exit Sub
End If

Set rng1 = Target.EntireRow.Range("A1:I1")

With Worksheets("outcomes")
Set rng2 = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Value <> "" Then
With rng1
.Copy _
Destination:=rng2
.Delete Shift:=xlUp
End With
End If
ws_exit:
Application.EnableEvents = True

End Sub


There are other ways, too:

Set rng1 = Target.EntireRow.Resize(1, 9)
(resize to 1 row by 9 columns)

or

with me 'to save typing
set rng1 = .range(.cells(target.row,"A"),.cells(target.row,"I"))
end with
 
I generally use EntireRow.Cells to get a cell relative to another cell
on the same row so that I don't have to remember just where the
initial range reference refers. For example,

Dim R As Range
Dim RR As Range
Set R = Range("F1")
Set RR=R.EntireRow.Cells(1,"M")

This way, the code neither knows nor cares what column is reference by
the R variable. RR will always point to column M as the same row as R,
regardless of the column of R.

In your example, I would use both EntireRow and Resize to get the
appropriate range:

Dim Rng1 As Range
Set Rng1 = Target.EntireRow.Cells(1, "A").Resize(9)

This sets Rng1 to the Target.Row columns A:I. The target column is
irrelevant and the code works properly regardless of Target's column.

Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
 
Brillian! Works splendidly :-)

Thank you

Dave Peterson said:
One way:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Const WS_RANGE As String = "J:J"
Dim rng1 As Range
Dim rng2 As Range

If Target.Cells.Count > 1 Then
Exit Sub 'single cell at a time
End If

If Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Exit Sub
End If

Set rng1 = Target.EntireRow.Range("A1:I1")

With Worksheets("outcomes")
Set rng2 = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Value <> "" Then
With rng1
.Copy _
Destination:=rng2
.Delete Shift:=xlUp
End With
End If
ws_exit:
Application.EnableEvents = True

End Sub


There are other ways, too:

Set rng1 = Target.EntireRow.Resize(1, 9)
(resize to 1 row by 9 columns)

or

with me 'to save typing
set rng1 = .range(.cells(target.row,"A"),.cells(target.row,"I"))
end with
Click to expand...
 
Back
Top