Search code - See any issues?

[erutherford]

found this piece code and its exactly as presented. It works in the provider demo, but not in my new workbook.

Error occurs at the bold red print (object define error)

Sub search_and_extract_singlecriteria()
Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim typename As String
Dim finalrow As Integer
Dim i As Integer

'set variables
Set datasheet = Sheet1
Set reportsheet = Sheet2
typename = reportsheet.Range("B2").Value

'clear old data
reportsheet.Range("A5:L100").ClearContents

'goto datasheet and start searching and copying
datasheet.Select
finalrow = Cells(Rows.Count, 1).End(x1Up).Row

For i = 2 To finalrow
    If Cells(i, 2) = typename Then
    Range(Cells(i, 1), Cells(i, 12)).Copy
    reportsheet.Select
    Range("A200").End(x1Up).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet.Select
    End If
Next i

reportsheet.Select

Range("B2").Select

End Sub

 

[MARK858]

It is suppose to find the first blank row then paste

Do you mean the first blank row or the first blank row after your data (2 different things), if you mean the latter then (and you didn't answer if it is only above A25 and the below assumes not)....

Just so I understand where you are what happens if you change

datasheet.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To finalrow
    If Cells(i, 2) = typename Then
    Range(Cells(i, 1), Cells(i, 9)).Copy
    reportsheet.Select
    Range("A25").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    datasheet.Select
    End If
Next i

reportsheet.Select

Range("B2").Select

to

    With datasheet
        finalrow = .Cells(Rows.Count, 1).End(xlUp).Row

        For i = 2 To finalrow
            If .Cells(i, 2) = typename Then
                .Range(.Cells(i, 1), .Cells(i, 9)).Copy
                reportsheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
        Next i
    End With
    Application.Goto reportsheet.Range("B2"), True

and you haven't answered Fluff's question

Fluff
Re: Search code - See any issues?

When you step through the code what is it doing?

Btw, the video isn't much use to us, a link to a free file sharing site like www.box.com or www.dropbox.com where you have uploaded a copy of a de-sensitised version of your file might be

 

[erutherford]

Mark - ok that works.

What would I change if I wanted the paste to start at A5?

What was the issue with the original code (just for some knowledge base)?

Fluff - The code would not return the query results. It looks like Mark made the code simpler.

thanks to both of you for the time!

 

[MARK858]

    With datasheet
        finalrow = .Cells(Rows.Count, 1).End(xlUp).Row

        For i = 2 To finalrow
            If .Cells(i, 2) = typename Then
                .Range(.Cells(i, 1), .Cells(i, 9)).Copy
                If reportsheet.Cells(Rows.Count, "A").End(xlUp).End(xlUp).Row < 4 Then
                    reportsheet.Cells(5, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Else
                    reportsheet.Cells(Rows.Count, "A").End(xlUp).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                End If
            End If
        Next i
    End With

What was the issue with the original code (just for some knowledge base)?

Can't guess I am afraid unless your use of A25 was incorrect.

 

[erutherford]

Mark - Well your version is cleaner, more direct it seems, so I'll go with it. But I'll see if I can figure out what the problem is with the other code, now that I have a working sample.

Thanks again

 

[MARK858]

You're welcome

 

[erutherford]

Mark, I for got to ask what if I have headers on the reportsheet. What can be done to keep them from being "cleared"?

 

[MARK858]

Mark, I for got to ask what if I have headers on the reportsheet. What can be done to keep them from being "cleared"?

Nothing in the code I posted clears anything (and the last code that I posted can paste above row 5). Please clarify your question.

 

[erutherford]

I didn't see the reply in time, but do now.

thanks