ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Moving a Selection of Data??? (https://www.excelbanter.com/excel-programming/348377-moving-selection-data.html)

Lime

Moving a Selection of Data???
 
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[_393_]

Moving a Selection of Data???
 

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

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=494370


Lime

Moving a Selection of Data???
 
Thanks Leith, I'll give it a try, Thanks for your time.

Lime


"Leith Ross" wrote:


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

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=494370



Lime

Moving a Selection of Data???
 
Hello,
All this does is add a sheet named Cause???

Lime

"Lime" wrote:

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

Lime


"Leith Ross" wrote:


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

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=494370



Tom Ogilvy

Moving a Selection of Data???
 
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.


--
Regards,
Tom Ogilvy


"Lime" wrote in message
...
Thanks Leith, I'll give it a try, Thanks for your time.

Lime


"Leith Ross" wrote:


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

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile:

http://www.excelforum.com/member.php...o&userid=18465
View this thread:

http://www.excelforum.com/showthread...hreadid=494370





Tom Ogilvy

Moving a Selection of Data???
 

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

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

--
Regards,
Tom Ogilvy


"Tom Ogilvy" wrote in message
...
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.


--
Regards,
Tom Ogilvy


"Lime" wrote in message
...
Thanks Leith, I'll give it a try, Thanks for your time.

Lime


"Leith Ross" wrote:


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

--------------------


Sincerely,
Leith Ross


--
Leith Ross


------------------------------------------------------------------------
Leith Ross's Profile:

http://www.excelforum.com/member.php...o&userid=18465
View this thread:

http://www.excelforum.com/showthread...hreadid=494370








All times are GMT +1. The time now is 10:25 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com