Moving a Selection of Data???

[Guest]

Hello,
Here is my set up. I have a sheet of data about 35,000 lines in in cloumn
"J" I would like to search for the text "Jump" in the entire column and when
I find it I want to copy that whole row of data along with the Heading &
format of the data sheet to a new sheet and name the sheet "Cause" and then
delete those rows from the data sheet.

Thanks,
Lime

 

[Leith Ross]

Hello Lime,

Here is a macro you can use to the job automatically. Add a VBA module
to your project and place this code in it. You can run the macro by
selecting it in the Macro list. Press ALT + F8 to bring up the dialog
in Excel or use the menu.


Code:
--------------------

Sub FindJump()

Dim Exists As Boolean
Dim firstaddress
Dim result As Range
Dim Wks

For Each Wks In Worksheets
If Wks.Name = "Cause" Then Exists = True
Next Wks

If Not Exists Then
Worksheets.Add
ActiveSheet.Name = "Cause"
End If

With Worksheets(1).Range("J1:J35000")
Set result = .Find(2, lookin:=xlValues)
If Not result Is Nothing Then
firstAddress = result.Address
Do
If result.value = "Jump" Then

result.delete(xlShiftUp)
End If
Set result = .FindNext(result)
Loop While Not result Is Nothing And result.Address <> firstAddress
End If
End With

End Sub

 

[Guest]

Thanks Leith, I'll give it a try, Thanks for your time.

Lime

 

[Guest]

Hello,
All this does is add a sheet named Cause???

Lime

 

[Tom Ogilvy]

That won't work because when you delete the cells reference by Result, and
then try to use it again, you get an error. Also, It appears Leith forgot
to add the part to copy to the sheet Cause.

Untested,

Sub FindJump()

Dim Exists As Boolean
Dim firstaddress as String
Dim result As Range
Dim Wks as Worksheet
Dim rng as Range

For Each Wks In Worksheets
If Wks.Name = "Cause" Then Exists = True
Next Wks

If Not Exists Then
Worksheets.Add
ActiveSheet.Name = "Cause"
End If

With Worksheets(2).Range("J1:J35000")
.Rows(1).Copy Worksheets("Cause").Range("A1")
Set result = .Find("Jump", After:=Worksheets(1).Range("J1"), _
LookIn:=xlValues)
If Not result Is Nothing Then
firstaddress = result.Address
Do
if not rng is nothing then
set rng = Union(rng, result.EntireRow)
else
set rng = result.EntireRow
End if
Set result = .FindNext(result)
Loop While Not result Is Nothing And result.Address <> firstaddress
End If
End With
If not rng is nothing then
rng.copy Destination:=Worksheets("Cause").Range("A2")
rng.Delete
End if
End Sub

The above worked for me.

 

[Tom Ogilvy]

With Worksheets(2).Range("J1:J35000")

change the 2 above to refer to the sheet containing Jump in column "J"