Alternative copy/delete method needed
 

Hi,
I am currently using the code below to copy a row of datat to the next sheet
and then delete the old data. This works perfectly until the workbook is
shared after which the delete part fails to work (but doesn't return an
error).
I have posted questions regarding this but the best brains have been unable
to replicate the error so have been unable to help.
I am therefore asking if anyone can rewrite this code using a different
method which I can then try to see if it will work.

Current code is:

Private Sub Worksheet_Change(ByVal Target As Range)

Const WS_RANGE As String = "J:J" 'This is the colum that runs the macro
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:J1") 'The range A1:J1 ensures the
copied data doesn't overwrite formatting on next sheet in columns K:L:M

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

Any help would be most welcome :-)

Alternative copy/delete method needed
 

Kev

If you check out help on troubleshooting shared workbooks you will see that
you cannot delete a single cell or blocks of cells.

Entire rows and columns only.

With rng1
..Copy _
Destination:=rng2
.Delete Shift:=xlUp 'cannot be done
End With
End If

..EntireRow.Delete Shift:=xlUp would be legal but probably not desirable


Gord Dibben MS Excel MVP

On Tue, 9 Feb 2010 01:31:01 -0800, KevHardy
wrote:

Hi,
I am currently using the code below to copy a row of datat to the next sheet
and then delete the old data. This works perfectly until the workbook is
shared after which the delete part fails to work (but doesn't return an
error).
I have posted questions regarding this but the best brains have been unable
to replicate the error so have been unable to help.
I am therefore asking if anyone can rewrite this code using a different
method which I can then try to see if it will work.

Current code is:

Private Sub Worksheet_Change(ByVal Target As Range)

Const WS_RANGE As String = "J:J" 'This is the colum that runs the macro
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:J1") 'The range A1:J1 ensures the
copied data doesn't overwrite formatting on next sheet in columns K:L:M

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

Any help would be most welcome :-)

Alternative copy/delete method needed
 

Thanks for this.
I have gone back to the entire.row method and found a different way to
address the original problem by including ALL the columns in ALL the sheets
and just hiding the ones I don't need on each sheet.
Works wonderfully.
Thanks again

"Gord Dibben" wrote:

Kev

If you check out help on troubleshooting shared workbooks you will see that
you cannot delete a single cell or blocks of cells.

Entire rows and columns only.

With rng1
..Copy _
Destination:=rng2
.Delete Shift:=xlUp 'cannot be done
End With
End If

..EntireRow.Delete Shift:=xlUp would be legal but probably not desirable


Gord Dibben MS Excel MVP

On Tue, 9 Feb 2010 01:31:01 -0800, KevHardy
wrote:

Hi,
I am currently using the code below to copy a row of datat to the next sheet
and then delete the old data. This works perfectly until the workbook is
shared after which the delete part fails to work (but doesn't return an
error).
I have posted questions regarding this but the best brains have been unable
to replicate the error so have been unable to help.
I am therefore asking if anyone can rewrite this code using a different
method which I can then try to see if it will work.

Current code is:

Private Sub Worksheet_Change(ByVal Target As Range)

Const WS_RANGE As String = "J:J" 'This is the colum that runs the macro
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:J1") 'The range A1:J1 ensures the
copied data doesn't overwrite formatting on next sheet in columns K:L:M

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

Any help would be most welcome :-)

.