Searching for a specific text and copy and paste into a new sheet.

[fizzyh]

need to copy an unknown number of rows after finding a specific word until the next word comes along. This is the database:

<CODE>Counterparty | 721 | 721 Healthcare | CCY | Invoice amount
12/03/14 | 12/10/14 | 081673 | USD | 1000
12/22/14 | 12/22/14 | 081954 | USD | 999
Counterparty | 722 | 722 Healthcare | CCY | Invoice Amount
12/22/14 | 12/22/14 | 081954 | USD | 999
12/22/14 | 12/22/14 | 081954 | USD | 999</CODE>
</PRE>This goes on and the amount of rows vary every month. I am only required to find one of the company(represented by 721). And what i need is to copy from the heading : Counterparty, 721, 721 Healthcare, CCY, Invoice Amount. Followed by the data beneath it until it hits a different company. Basically copy from only 721 and all the information until it hit 722 and paste it onto a new worksheet.

What i got right now is this

Sub bgtoutflow()
Dim SearchItem As String
Dim SearchResult As Range
Dim LastRowWS As Long
Dim SWS As Worksheet
Dim CopyRow As Long
Dim PasteSeq As Integer
Dim CopyStart As Long
 
Set SWS = Sheets("Sheet2")
SearchItem = "*721 :*"
PasteSeq = 0
CopyStart = 1
LastRowWS = Range("B241").End(xlDown).Row
For i = 1 To LastRowWS
    With SWS.Range("B:B")
        'dynamic range to find next item
        Set SearchResult = .Find(What:=SearchItem, _
        After:=Range("B" & i), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        If Not SearchResult Is Nothing Then
                PasteSeq = PasteSeq + 1 'For new sheetname
                On Error GoTo LastRow 'For the last part
                CopyRow = SearchResult.Offset(-1, 0).Row
                Rows(CopyStart & ":" & CopyRow).Copy
                Sheets.Add.Name = "PasteSheet" & PasteSeq
                Sheets("PasteSheet" & PasteSeq).Range("A1").PasteSpecial xlPasteAll
                Sheets("Search").Select
                CopyStart = SearchResult.Row
                i = CopyRow 'SearchResult.Row
        End If
    End With
Next
LastRow:
Rows(CopyRow + 1 & ":" & LastRowWS).Copy
Sheets.Add.Name = "PasteSheet" & PasteSeq
Sheets("PasteSheet" & PasteSeq).Range("A1").PasteSpecial xlPasteAll
Sheets("Search").Select
End Sub

It gives me error 9. Subscription out of range.
Thanks in advance guys

 

[Michael M]

At first glance you either don't have "Sheet9" a "Sheet2" a "PasteSheet" or a "Search" sheet
If you step through the code using F8, the error 9 line should be highlighted in yellow

 

[fizzyh]

Hi! Thanks for the response. I've removed the Search sheet codes and now faced with error 1004. And it stops at this line

Sheets("PasteSheet" & PasteSeq).Range("A1").PasteSpecial xlPasteAll

 

[hiker95]

fizzyh,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


You want to search in Sheets("Sheet2"), column B for "*721 :*"

But, in your posted string raw data what is in column B is 721


To start off, and, so that we can get it right on the first try:

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post a small screen shot try one of the following:

Excel Jeanie
Download

MrExcel HTML Maker
https://onedrive.live.com/?cid=8cffdec0ce27e813&sc=documents&id=8CFFDEC0CE27E813!189

Borders-Copy-Paste
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045

To test the above:
Test Here


Or, you can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[fizzyh]

Hi! I'm using Windows 7. Its really difficult to send a screenshot because theres too much data. And i am not able to post it up on box net because my company has a tight security. I apologized. I will try to screenshot my data. Thank you for your time.

 

[hiker95]

fizzyh,

Thanks for the feedback.

Will check later for the screenshot(s).

 

[fizzyh]

Hi! i created a dropbox link to show the screendhots.

https://www.dropbox.com/s/1hvshtdun9gxq3v/0.png?dl=0
https://www.dropbox.com/s/or8tlxkgg3su5d2/1.png?dl=0

 

[hiker95]

fizzyh,

You are posting pictures/graphics/PNGs. This means that if this was a problem where one needed to use your data, anyone trying to help you would have to enter the data manually. That makes no sense.


If you are not able to give us your actual raw data workbook/worksheets, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[fizzyh]

Bump