PDA

View Full Version : Solved: Removing and pasting rows using a collection?



marshybid
12-05-2007, 01:51 AM
Hi, I'm trying to use the following code to paste Rows from one worksheet to another then remove from the original worksheet using a collection.

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

herzberg
12-05-2007, 02:21 AM
I'm not sure if this will work but you can give it a shot.

Dim myTargetSheet1 As Worksheet
Dim myTargetSheetRow1 As Integer
Dim myBaseWorkSheet As Worksheet
Dim RowsCounter As Long
Dim CopyRange As Range

Set myTargetSheet1 = Sheets("Removed Data 1")
Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
myTargetSheetRow1 = 1

With myBaseWorkSheet

For RowsCounter = myBaseRange.Rows.Count To 2 Step -1

If Len(.Cells(RowsCounter, 7).Value) <> 0 Then

Select Case .Cells(RowsCounter, 21).Value

Case Is <> "CV Submitted", "1st Interview", "2nd Interview", _
"3rd Interview", "4th Interview", "Intent to Offer", _
"Offered", "Offer Accepted", "Hired"
Set CopyRange = .Range(Cells(RowsCounter, .Cells(1, 1).End(xlToRight).Column), _
Cells(RowsCounter, .Cells(1, 1).End(xlToRight).Column))
CopyRange.copy myTargetSheet1.Cells(myTargetSheetRow1, 1)
myTargetSheetRow1 = myTargetSheetRow1 + 1

CopyRange.Delete Shift:=xlShiftUp
End Select
End If
Next

Application.CutCopyMode = False

End With
Instead of the lengthy and cumbersome IF statement, I replaced it with a Select Case statement.

marshybid
12-05-2007, 02:59 AM
HI Herzberg, Thanks for the quick reply.

I have tried the code you provided with one minor amendment (see below)


Dim myTargetSheet1 As Worksheet
Dim myTargetSheetRow1 As Integer
Dim myBaseWorkSheet As Worksheet
Dim RowsCounter As Long
Dim CopyRange As Range

Set myTargetSheet1 = Sheets("Removed Data 1")
Set myBaseWorkSheet = Sheets("Raw Data")
myTargetSheetRow1 = 1

With myBaseWorkSheet

For RowsCounter = myBaseRange.Rows.Count To 2 Step -1

If Len(.Cells(RowsCounter, 7).Value) <> 0 Then

Select Case .Cells(RowsCounter, 21).Value

Case Is <> "CV Submitted", "1st Interview", "2nd Interview", _
"3rd Interview", "4th Interview", "Intent to Offer", _
"Offered", "Offer Accepted", "Hired"
Set CopyRange = .Range(Cells(RowsCounter, .Cells(1, 1).End(xlToRight).Column), _
Cells(RowsCounter, .Cells(1, 1).End(xlToRight).Column))
CopyRange.copy myTargetSheet1.Cells(myTargetSheetRow1, 1)
myTargetSheetRow1 = myTargetSheetRow1 + 1

CopyRange.Delete Shift:=xlShiftUp
End Select
End If
Next

Application.CutCopyMode = False

End With

However, when I run it it seems to get itself stuck in a perpetual loop!!! When I force it to stop, the "Removed Data 1" shett only contains data in column A with #REF in it???

Any thoughts? Help greatly appreciated :bow:

Bob Phillips
12-05-2007, 03:08 AM
Post your workbook!

marshybid
12-05-2007, 05:04 AM
As requested, workbook attached. I have had to remove all other data due to sensitivity.

Help geatly appreciated. :yes

rory
12-05-2007, 06:21 AM
How's this:

Sub CleanUpData()
Dim myTargetSheet1 As Worksheet, myBaseWorksheet As Worksheet
Dim MyBaseRange As Range, rngTarget As Range, myBaseRow As Range
Dim myTargetSheetRow1 As Long ' Use Longs for row number variables
Dim RowsCounter As Long
myTargetSheetRow1 = 1

Set myTargetSheet1 = Sheets("Removed Data 1")
Set myBaseWorksheet = Sheets("Raw Data")
Set MyBaseRange = myBaseWorksheet.UsedRange.Rows

Application.ScreenUpdating = False
For RowsCounter = MyBaseRange.Rows.Count To 2 Step -1
Set myBaseRow = MyBaseRange.Item(RowsCounter)
If Len(myBaseRow.Cells(1, 7)) <> 0 Then

Select Case myBaseRow.Cells(1, 21)
Case "CV Submitted", "1st Interview", "2nd Interview", "3rd Interview", _
"4th Interview", "Intent to Offer", "Offered", "Offer Accepted", "Hired"
Case Else
myBaseRow.Copy myTargetSheet1.Cells(myTargetSheetRow1, 1)
myTargetSheetRow1 = myTargetSheetRow1 + 1
myBaseRow.Delete
End Select

End If
Next RowsCounter
Application.ScreenUpdating = True
End Sub

marshybid
12-05-2007, 07:10 AM
Rory, that works great.

Thanks for the help. :bow:

Marshybid