Copy a Range of data from an extensive list based on Criteria from a specific column

[B4andafter]

Hello guys, I have a list of purchase orders (PO's) in sequential order (one below the other) all in excel that begin with a company name in Column A, "Cardiac.." and ends with a "Signature" line also in column A. The PO's data are occupy Column A to Column I. Each purchase order is of different size, i.e. uses up multiple rows. My objective here is if there is the word "Accrue" in Column K on a certain line of the purchase order, I want to copy and paste that particular purchase order and paste it on a different worksheet and have this repeat until final row. Currently I am copying and pasting this manually and it is time consuming.

Also, The company name is always in Column A and 13 rows above the word "Accrue" which is in column K.

Below is the code that I am using but I am getting a Run-time error '13' Type mismatch. Your help is much appreciated.
By the way I have been using Mr. Excel's VBA and Macros book as a guide but this is tricky for me. Thanks in advance.


Sub Accruev2()
Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim finalrow As Integer
Dim i As Integer
Dim Accrue As String
'set variables
Set datasheet = Sheet18
Set reportsheet = Sheet21
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 11) = "Accrue" Then
Set iTempRow = Cells(i, 1).Find(What:="Cardiac*", After:=Cells(i - 14, 1), searchorder:=xlByRows, searchdirection:=xlPrevious)
Set endcell = Cells(i, 1).Find(What:="Signature*", After:=Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Range(Cells(iTempRow, 1), Cells(endcell, 11)).Copy
reportsheet.Select
Range("A10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAllUsingSourceTheme
datasheet.Select
End If
Next i
End Sub

 

[JLGWhiz]

Set iTempRow = Cells(i, 1).Find(What:="Cardiac*", After:=Cells(i - 14, 1), searchorder:=xlByRows, searchdirection:=xlPrevious)
Set endcell = Cells(i, 1).Find(What:="Signature*", After:=Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False, SearchFormat:=False)

These don't work well using the wildcard asteriisk in the search criteria. Use the 'xlPart' parameter instead.

Set iTempRow = Cells(i, 1).Find(What:="[COLOR=#daa520]Cardiac[/COLOR]", After:=Cells(i - 14, 1), LookIn:=xlValues, [COLOR=#ff0000]LookAt:=xlPart, [/COLOR]searchorder:=xlByRows, searchdirection:=xlPrevious)
Set endcell = Cells(i, 1).Find(What:="[COLOR=#daa520]Signature[/COLOR]", After:=Cells(i, 1), LookIn:=xlValues, [COLOR=#ff0000]LookAt:=xlPart, [/COLOR]searchorder:=xlByRows, _
 searchdirection:=xlNext, MatchCase:=False, SearchFormat:=False)

Don't know if that fixes your 'Type Mismatch' or not. You did not specify which line was highlighted when you click 'Debug'.

P.S. Don't know why you are declaring 'Accrue' as a variable. It is a data element in your sheet.

 

[Akuini]

Hi, B4andafter
Try this:
I assumed the data is in col A:K.
I put the result in “sheet2”, you may change that to suit.

---

Please use Code Tags when posting a code. Like this: [CODE ]Your Code Here[/ CODE]

[B][COLOR=Royalblue]Sub[/COLOR][/B] a1018286c[B]()[/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] c [B][COLOR=Royalblue]As[/COLOR][/B] Range[B],[/B] d [B][COLOR=Royalblue]As[/COLOR][/B] Range[B],[/B] f [B][COLOR=Royalblue]As[/COLOR][/B] Range[B],[/B] sAddress [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]String[/COLOR][/B]
 
Application.ScreenUpdating [B]=[/B] [B][COLOR=Royalblue]False[/COLOR][/B]
    [B][COLOR=Royalblue]Set[/COLOR][/B] ws [B]=[/B] Sheets[B]([/B][B][COLOR=brown]"sheet2"[/COLOR][/B][B])[/B] [FONT=trebuchet ms][I][COLOR=Lightseagreen]'change to suit.[/COLOR][/I][/FONT]
    [B][COLOR=Royalblue]Set[/COLOR][/B] f [B]=[/B] Range[B]([/B][B][COLOR=brown]"A1"[/COLOR][/B][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]).[/B][B][COLOR=Royalblue]End[/COLOR][/B][B]([/B]xlUp[B]))[/B]
    x [B]=[/B] Range[B]([/B][B][COLOR=brown]"A:A"[/COLOR][/B][B]).[/B]Find[B]([/B][B][COLOR=brown]"Cardiac"[/COLOR][/B][B],[/B] LookIn[B]:=[/B]xlValues[B],[/B] LookAt[B]:=[/B]xlPart[B],[/B] SearchOrder[B]:=[/B]xlByRows[B],[/B] SearchDirection[B]:=[/B]xlPrevious[B],[/B] _
                    MatchCase[B]:=[/B][B][COLOR=Royalblue]False[/COLOR][/B][B],[/B] SearchFormat[B]:=[/B][B][COLOR=Royalblue]False[/COLOR][/B][B]).[/B]row
    i [B]=[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B]
 
    [B][COLOR=Royalblue]Do[/COLOR][/B]
        [B][COLOR=Royalblue]Set[/COLOR][/B] c [B]=[/B] f.Find[B]([/B]What[B]:=[/B][B][COLOR=brown]"Cardiac"[/COLOR][/B][B],[/B] LookIn[B]:=[/B]xlValues[B],[/B] After[B]:=[/B]Cells[B]([/B]i[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] LookAt[B]:=[/B]xlPart[B],[/B] SearchOrder[B]:=[/B]xlByRows[B],[/B] SearchDirection[B]:=[/B]xlNext[B],[/B] _
                    MatchCase[B]:=[/B][B][COLOR=Royalblue]False[/COLOR][/B][B],[/B] SearchFormat[B]:=[/B][B][COLOR=Royalblue]False[/COLOR][/B][B])[/B]
        [B][COLOR=Royalblue]Set[/COLOR][/B] d [B]=[/B] f.Find[B]([/B]What[B]:=[/B][B][COLOR=brown]"Signature"[/COLOR][/B][B],[/B] LookIn[B]:=[/B]xlValues[B],[/B] After[B]:=[/B]Cells[B]([/B]c.row[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] LookAt[B]:=[/B]xlPart[B],[/B] SearchOrder[B]:=[/B]xlByRows[B],[/B] SearchDirection[B]:=[/B]xlNext[B],[/B] _
                    MatchCase[B]:=[/B][B][COLOR=Royalblue]False[/COLOR][/B][B],[/B] SearchFormat[B]:=[/B][B][COLOR=Royalblue]False[/COLOR][/B][B])[/B]
               
                [B][COLOR=Royalblue]If[/COLOR][/B] InStr[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B][B],[/B] c.Offset[B]([/B][B][B][COLOR=crimson]13[/COLOR][/B][/B][B],[/B] [B][B][COLOR=crimson]10[/COLOR][/B][/B][B]),[/B] [B][COLOR=brown]"Accrue"[/COLOR][/B][B],[/B] vbTextCompare[B])[/B] [B][COLOR=Royalblue]Then[/COLOR][/B]
                    z [B]=[/B] ws.Cells[B]([/B]Rows.count[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]).[/B][B][COLOR=Royalblue]End[/COLOR][/B][B]([/B]xlUp[B]).[/B]row [B]+[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B]
                    ws.Range[B]([/B]ws.Cells[B]([/B]z[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] ws.Cells[B]([/B]z [B]+[/B] d.row [B]-[/B] c.row[B],[/B] [B][COLOR=brown]"K"[/COLOR][/B][B])).[/B]Value [B]=[/B] _
                    Range[B]([/B]Cells[B]([/B]c.row[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] Cells[B]([/B]d.row[B],[/B] [B][COLOR=brown]"K"[/COLOR][/B][B])).[/B]Value
                [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
                   
        i [B]=[/B] d.row
   
    [B][COLOR=Royalblue]Loop[/COLOR][/B] [B][COLOR=Royalblue]Until[/COLOR][/B] x [B]=[/B] c.row
 
Application.ScreenUpdating [B]=[/B] [B][COLOR=Royalblue]True[/COLOR][/B]
 
[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]

---

 

[B4andafter]

Hi, B4andafter
Try this:
I assumed the data is in col A:K.
I put the result in “sheet2”, you may change that to suit.

---

Please use Code Tags when posting a code. Like this: [CODE ]Your Code Here[/ CODE]

[B][COLOR=royalblue]Sub[/COLOR][/B] a1018286c[B]()[/B]
[B][COLOR=royalblue]Dim[/COLOR][/B] c [B][COLOR=royalblue]As[/COLOR][/B] Range[B],[/B] d [B][COLOR=royalblue]As[/COLOR][/B] Range[B],[/B] f [B][COLOR=royalblue]As[/COLOR][/B] Range[B],[/B] sAddress [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]String[/COLOR][/B]
 
Application.ScreenUpdating [B]=[/B] [B][COLOR=royalblue]False[/COLOR][/B]
    [B][COLOR=royalblue]Set[/COLOR][/B] ws [B]=[/B] Sheets[B]([/B][B][COLOR=brown]"sheet2"[/COLOR][/B][B])[/B] [FONT=trebuchet ms][I][COLOR=lightseagreen]'change to suit.[/COLOR][/I][/FONT]
    [B][COLOR=royalblue]Set[/COLOR][/B] f [B]=[/B] Range[B]([/B][B][COLOR=brown]"A1"[/COLOR][/B][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]).[/B][B][COLOR=royalblue]End[/COLOR][/B][B]([/B]xlUp[B]))[/B]
    x [B]=[/B] Range[B]([/B][B][COLOR=brown]"A:A"[/COLOR][/B][B]).[/B]Find[B]([/B][B][COLOR=brown]"Cardiac"[/COLOR][/B][B],[/B] LookIn[B]:=[/B]xlValues[B],[/B] LookAt[B]:=[/B]xlPart[B],[/B] SearchOrder[B]:=[/B]xlByRows[B],[/B] SearchDirection[B]:=[/B]xlPrevious[B],[/B] _
                    MatchCase[B]:=[/B][B][COLOR=royalblue]False[/COLOR][/B][B],[/B] SearchFormat[B]:=[/B][B][COLOR=royalblue]False[/COLOR][/B][B]).[/B]row
    i [B]=[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B]
 
    [B][COLOR=royalblue]Do[/COLOR][/B]
        [B][COLOR=royalblue]Set[/COLOR][/B] c [B]=[/B] f.Find[B]([/B]What[B]:=[/B][B][COLOR=brown]"Cardiac"[/COLOR][/B][B],[/B] LookIn[B]:=[/B]xlValues[B],[/B] After[B]:=[/B]Cells[B]([/B]i[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] LookAt[B]:=[/B]xlPart[B],[/B] SearchOrder[B]:=[/B]xlByRows[B],[/B] SearchDirection[B]:=[/B]xlNext[B],[/B] _
                    MatchCase[B]:=[/B][B][COLOR=royalblue]False[/COLOR][/B][B],[/B] SearchFormat[B]:=[/B][B][COLOR=royalblue]False[/COLOR][/B][B])[/B]
        [B][COLOR=royalblue]Set[/COLOR][/B] d [B]=[/B] f.Find[B]([/B]What[B]:=[/B][B][COLOR=brown]"Signature"[/COLOR][/B][B],[/B] LookIn[B]:=[/B]xlValues[B],[/B] After[B]:=[/B]Cells[B]([/B]c.row[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] LookAt[B]:=[/B]xlPart[B],[/B] SearchOrder[B]:=[/B]xlByRows[B],[/B] SearchDirection[B]:=[/B]xlNext[B],[/B] _
                    MatchCase[B]:=[/B][B][COLOR=royalblue]False[/COLOR][/B][B],[/B] SearchFormat[B]:=[/B][B][COLOR=royalblue]False[/COLOR][/B][B])[/B]
               
                [B][COLOR=royalblue]If[/COLOR][/B] InStr[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B][B],[/B] c.Offset[B]([/B][B][B][COLOR=crimson]13[/COLOR][/B][/B][B],[/B] [B][B][COLOR=crimson]10[/COLOR][/B][/B][B]),[/B] [B][COLOR=brown]"Accrue"[/COLOR][/B][B],[/B] vbTextCompare[B])[/B] [B][COLOR=royalblue]Then[/COLOR][/B]
                    z [B]=[/B] ws.Cells[B]([/B]Rows.count[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]).[/B][B][COLOR=royalblue]End[/COLOR][/B][B]([/B]xlUp[B]).[/B]row [B]+[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B]
                    ws.Range[B]([/B]ws.Cells[B]([/B]z[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] ws.Cells[B]([/B]z [B]+[/B] d.row [B]-[/B] c.row[B],[/B] [B][COLOR=brown]"K"[/COLOR][/B][B])).[/B]Value [B]=[/B] _
                    Range[B]([/B]Cells[B]([/B]c.row[B],[/B] [B][COLOR=brown]"A"[/COLOR][/B][B]),[/B] Cells[B]([/B]d.row[B],[/B] [B][COLOR=brown]"K"[/COLOR][/B][B])).[/B]Value
                [B][COLOR=royalblue]End[/COLOR][/B] [B][COLOR=royalblue]If[/COLOR][/B]
                   
        i [B]=[/B] d.row
   
    [B][COLOR=royalblue]Loop[/COLOR][/B] [B][COLOR=royalblue]Until[/COLOR][/B] x [B]=[/B] c.row
 
Application.ScreenUpdating [B]=[/B] [B][COLOR=royalblue]True[/COLOR][/B]
 
[B][COLOR=royalblue]End[/COLOR][/B] [B][COLOR=royalblue]Sub[/COLOR][/B]

---

Thanks for the fast response! This works out great, you guys rock!!! I see what you did there with Do Loop Until command, this was my gateway to getting the job done easier. Keep up the great work!! TTYL

 

[B4andafter]

Thanks for the fast response and the advise! My apologies on not highlighting where the error was. You guys are the best!!

 

[JLGWhiz]

Thanks for the fast response and the advise! My apologies on not highlighting where the error was. You guys are the best!!

Happy to assist,
regards, JLG

 

[Akuini]

Thanks for the fast response! This works out great, you guys rock!!! I see what you did there with Do Loop Until command, this was my gateway to getting the job done easier. Keep up the great work!! TTYL

You're welcome & thanks for replying.

---

And you can also click ‘Thank you for posting this’ and ‘Like this post’ button in the post that you like.