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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.