Remove and paste data from worksheets using a collection?

[marshybid]

Hi, I'm trying to use the following code to paste data from one worksheet to another and then remove the data from the original worksheet.

It doesn't work as I don't think the collection function alloows .add (code below)

Can anyone suggest a method/fix.

Thanks, Marshybid

Sheets("Raw Data").Select
Dim myTargetSheet1 As Worksheet
Dim myTargetSheetRow1 As Integer
myTargetSheetRow1 = 1

Set myTargetSheet1 = Sheets("Removed Data 1")
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
Set myBaseRange = myBaseWorkSheet.Rows
For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = myBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells.Item(1, 7)) <> 0 Then

If myBaseRow.Cells.Item(1, 21) <> "CV Submitted" Or myBaseRow.Cells.Item(1, 21) <> "1st Interview" _
Or myBaseRow.Cells.Item(1, 21) <> "2nd Interview" Or myBaseRow.Cells.Item(1, 21) <> "3rd Interview" _
Or myBaseRow.Cells.Item(1, 21) <> "4th Interview" Or myBaseRow.Cells.Item(1, 21) <> "Intent to Offer" _
Or myBaseRow.Cells.Item(1, 21) <> "Offered" Or myBaseRow.Cells.Item(1, 21) <> "Offer Accepted" _
Or myBaseRow.Cells.Item(1, 21) <> "Hired" Then
Set myTargetSheet1.Rows.Add(myTargetSheetRow1) = myBaseRow
myTargetSheetRow1 = myTargetSheetRow1 + 1

myBaseRow.Delete

End If
End If
Next

 

[Bong]

First of all, your base range (Set myBaseRange = myBaseWorkSheet.Rows) includes all the rows on your base sheet whether they have data or not. That seems inefficient.

Second of all, while rows is a collection, you don't really need to (or should) do what your doing. A better way is to just equate them.

First find the last row on your base sheet.
intLastRow = myBaseWorkSheet.cells(1,7).end(xlDown).row, assuming that column 7 is contiguous over the range.
Now you can loop from intLastRow to 2.

You don't need to use the item property of the cells collection; just reference the cells by row, column index (I assume that's what you're trying to indicate with ...Item(x,y)).

Then do your conditional checks as you see fit and when you want to:
myTargetSheet1.rows(intLastRow-RowsCounter+2) = myBaseWorkSheet.rows(RowsCounter).value


_________________
Bob Rashkin

 

[WinblowsME]

Sub TEST()
   Dim data_sheet As Worksheet, target_sheet As Worksheet
   Dim i As Long, j As Long, curr_cell As String
   
   Set data_sheet = Sheets("Raw Data")
   Set target_sheet = Sheets("Removed Data 1")
   
   Sheets("Raw Data").Select
   last_row = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row   
   j = 1
   
   For i = last_row To 2 Step -1
      If Trim(data_sheet.Cells(i, 7)) <> "" Then
         curr_cell = data_sheet.Cells(i, 21)
      
         If Valid_Cell(curr_cell) Then
            data_sheet.Range(i & ":" & i).Copy target_sheet.Range(j & ":" & j)
            data_sheet.Range(i & ":" & i).EntireRow.Delete
            j = j + 1
         End If
      End If
   Next
End Sub

Private Function Valid_Cell(curr_cell As String) As Boolean
   curr_cell = Trim(UCase(curr_cell))
   
   If curr_cell = "CV SUBMITTED" Or curr_cell = "1ST INTERVIEW" Or curr_cell = "2ND INTERVIEW" Or _
      curr_cell = "3RD INTERVIEW" Or curr_cell = "4TH INTERVIEW" Or curr_cell = "INTENT TO OFFER" Or _
      curr_cell = "OFFERED" Or curr_cell = "OFFER ACCEPTED" Or curr_cell = "HIRED" Then
      Valid_Cell = False
   Else
      Valid_Cell = True
   End If
End Function

 

[WinblowsME]

data_sheet.Select

 

[WinblowsME]

Also, your logic is off. The following will always evalute to true.

If myBaseRow.Cells.Item(1, 21) <> "CV Submitted" Or myBaseRow.Cells.Item(1, 21) <> "1st Interview" Or _
   myBaseRow.Cells.Item(1, 21) <> "2nd Interview" Or myBaseRow.Cells.Item(1, 21) <> "3rd Interview" Or _
   myBaseRow.Cells.Item(1, 21) <> "4th Interview" Or myBaseRow.Cells.Item(1, 21) <> "Intent to Offer" Or _
   myBaseRow.Cells.Item(1, 21) <> "Offered" Or myBaseRow.Cells.Item(1, 21) <> "Offer Accepted" Or _
   myBaseRow.Cells.Item(1, 21) <> "Hired" Then