VBA in Excel to Find all containing specific text and copy and paste to new worksheet

Question

I am new to VBA and am trying to recreate the Find All function in my Quote Worksheet to copy and paste any line in the B column (between B30 and B350) containing , CB (in the middle of the text) to copy and paste into a new worksheet (Work Order) to formulate a parts list at column AA.

Sub CreateWorkOrder()
 Dim quote As Worksheet
 Dim Work_Order As Worksheet
 Dim CB As String
 Dim finalrow As Integer
 Dim i As Integer

Set quote = Sheet1
Set Work_Order = Sheet10
CB = quote.Range("B2").Value
number = "*, CB*"

'goto sheet and start searching and copying
quote.Select
finalrow = 350

'loop through the rows to find the matching records
For i = 30 To finalrow

If Cells(i, 2) = CB Then
    Range(Cells(i, 1), Cells(i, 2)).Copy
    Work_Order.Select
    Range("AA300").End(xlUp).Offset(1, 0).PasteSpecial xlpastevalue
    Range("AA" & i + 1).PasteSpecial xlPasteValues
    quote.Select
    End If
Next i
Work_Order.Select
Range("B21").Select
End Sub

I get a PasteSpecial method of range class failed at

Range("AA300").End(xlUp).Offset(1, 0).PasteSpecial xlpastevalue

score 1 · Accepted Answer · answered Jul 16 '19 at 16:45

1

There's usually no need to use .Select, and it's best to avoid using .Select.

Try this:

Sub CreateWorkOrder()
Dim quote As Worksheet
Dim Work_Order As Worksheet
Dim CB As String
Dim finalrow As Integer
Dim i As Integer

Set quote = Sheet1
Set Work_Order = Sheet10
CB = quote.Range("B2").Value
Number = "*, CB*"

finalrow = 350

'loop through the rows to find the matching records
For i = 30 To finalrow
    If quote.Cells(i, 2) = CB Then
        quote.Range(quote.Cells(i, 1), quote.Cells(i, 2)).Copy
        Work_Order.Range("AA300").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Work_Order.Range("AA" & i + 1).PasteSpecial xlPasteValues
    End If
Next i
'  Leaving in the below just so it goes to a sheet
'  and selects the cell for the user.
Work_Order.Activate
Work_Order.Range("B21").Select
End Sub

answered Jul 16 '19 at 16:45

BruceWayne

22,923
15
65
110

i did change the line If quote.Cells(i,2) to If quote,Cells(i,1) and it will paste everything. I seem to be missing the filter part to find only numbers starting with CB. – Kassie Storm Jul 16 '19 at 17:40
and is there a way to ignore the hidden rows? – Kassie Storm Jul 16 '19 at 18:03
@KassieStorm - To ignore a hidden row, in your `for i` loop, perhaps do `If quote.Cells(i,2).EntireRow.Hidden = False Then // If quote.Cells(i,2) = CB ...` – BruceWayne Jul 16 '19 at 18:07
where do I specify what the loop should be searching for? It is copying and pasting all of the information on the page instead of just the lines containing CB – Kassie Storm Jul 17 '19 at 12:16

score 0 · Answer 2 · answered Jul 16 '19 at 17:09

AutoFilter method to avoid a loop:

Sub CreateWorkOrder()

    Dim quote As Worksheet
    Dim Work_Order As Worksheet
    Dim CB As String

    Set quote = Sheet1
    Set Work_Order = Sheet10
    CB = quote.Range("B2").Value
    If Len(CB) = 0 Then Exit Sub    'No criteria

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With quote.Range("B29", quote.Cells(quote.Rows.Count, "B").End(xlUp))
        If .Row = 29 And .Rows.Count > 1 Then
            .AutoFilter 1, "*" & CB & "*"
            Intersect(.Parent.Range("A:B"), .Offset(1).EntireRow).Copy
            Work_Order.Cells(Work_Order.Rows.Count, "AA").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            .AutoFilter
        End If
    End With

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

This showed no results for me. I put in a hidden text in rows for it to skip over also and that did not work. — Kassie Storm, Jul 16 '19 at 17:33

VBA in Excel to Find all containing specific text and copy and paste to new worksheet

2 Answers2