Cut and Paste from Collection

  • Thread starter Thread starter DJ
  • Start date Start date
D

DJ

Hello - I'm looking for help on cutting and pasting rows between two
worksheets while enumerating a collection.

Sheet1 (wsADJUSTED) contains rows of invoice information. For each invoice
having a status of 9 in column P, I'd like to cut and paste the entire row
from Sheet1 to Sheet2 (wsDELETED), and delete the original row from Sheet1.
Here's a code snippet:

For Each AdjustedInvoicesCell In AdjustedInvoices
If (StrComp(AdjustedInvoicesCell.Offset(0, 11), "9")) = 0 Then
Worksheets(wsADJUSTED).Rows(n).Cut
Destination:=Worksheets(wsDELETED).Range("A65536").End(xlUp).Offset(1, 0)
Worksheets(wsADJUSTED).Rows(n).Delete
End If
Next AdjustedInvoicesCell

There are two problems with this that I can't figure out:
1. All rows in Sheet1 (wsADJUSTED) don't get processed. Is this because I'm
deleting rows from a collection while trying to enumerate it at the same
time? How can this be avoided?
2. The rows pasted to Sheet2 (wsDELETED) overwrite one another. I can't find
a solution to advance the row on Sheet2 where the cut row from Sheet1 should
be pasted.

All suggestions are appreciated. Thank you.
 
This is an example of how I'd do this. I did a copy rather than a cut which
I think is okay based on your description of the data, so that I can do it
in one step.

Sub a()
Dim Cell As Range
Dim CutRg As Range
For Each Cell In Sheet1.Range("A1:A20")
If Cell.Offset(0, 15).Value = 9 Then
If CutRg Is Nothing Then
Set CutRg = Cell.EntireRow
Else
Set CutRg = Union(CutRg, Cell.EntireRow)
End If
End If
Next
If Not CutRg Is Nothing Then
CutRg.Copy Sheet2.Range("A1")
CutRg.Delete
End If
End Sub
 
Thanks for the suggestion, Jim. It worked great.

Just for informational purposes, if I cut (instead of copy) from a range
within the For Each loop, does that mess up the range?

Thanks,

~ Dave
 
Back
Top