Finding a (Changing)value and cutting all data to a new sheet

Posted by George on December 18, 2000 8:03 AM

I am trying to find a value in a column. when that value is found, I need to select all rows with this value, select them, cut and paste all rows to a new page. I am having a problem with selecting all rows with this value. I can find it with the following protion of my macro:
Selection.Find(What:="2", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

As of now all rows have a value of 1 or 2.
I can cut and paste to a new sheet, but now it is coded into the formula. ( as :
ange(Selection, Selection.End(xlUp)).Select
Range("L2:L9706").Select
Range("L9706").Activate
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Cut
Sheets.Add

Is there a way to have this active cell constantly changing and not hard coded into the formula?

Posted by Tim Francis-Wright on December 18, 2000 11:40 PM

I think that something like the following will
do what you want... as I see it, you might not
want to use .Find here:

Sub TwoBeGone()
'If I were really clever, there would be a Prisoner joke here

Dim Cutrange As Object, Flag As Boolean, c As Object
Dim FirstSheet As Object, a As Object

Flag = False
Set FirstSheet = ActiveSheet

' Assemble the rows to copy
For Each c In ActiveSheet.UsedRange.Cells
If c.Value = 2 Then
If Flag Then
Set Cutrange = Union(Cutrange, c.EntireRow)
Else
Flag = True
Set Cutrange = c.EntireRow
End If
End If
Next c

'copy and paste the rows
Cutrange.Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste

FirstSheet.Activate
Range("A1").Select
For Each a In Cutrange.Areas
' a.Delete to Delete Row, a.Clear to Cut Row
a.Clear
MsgBox a.Address
Next a

End Sub