I cant define the finalrow properly

Question

I tried to make a VBA that copies the rows containing a specific value to another worksheet. I came across the guy on youtube (https://www.youtube.com/watch?v=-QFjJoRGCtU&t=332s) and followed his formulas. When I try to run it, it only copy&paste the 1st row to another worksheet. I'm guessing that I didn't define the finalrow properly that's why it failed. Care to fix my code for me?

Here's my code:

Sub Search_Extract()
    Dim resultnumber As Integer
    Dim finalrow As Long
    Dim datasheet As Worksheet, reportsheet As Worksheet
    Dim i As Integer 'rowcounter

    Set datasheet = Sheet4
    Set reportsheet = Sheet3
    resultnumber = reportsheet.Range("A1").Value

    reportsheet.Range("D5:F7000").ClearContents

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

    For i = 1 To finalrow
        If Cells(i, 3) = resultnumber Then
            Range(Cells(i, 1), Cells(i, 3)).Copy
            reportsheet.Select
            Range("D6700").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
    Next i

    reportsheet.Select
End Sub

The code works however, it doesn't copy and paste other rows containing the desired value. or maybe the loop isn't working that's why it only copies one row? — PADILLA JOHN JERICHO R, Jun 18 '21 at 16:22
A simple search would have gotten you a dozen answers. [1](https://stackoverflow.com/q/58605686/14608750) , [2](https://stackoverflow.com/q/17601710/14608750) , [3](https://stackoverflow.com/q/7878192/14608750) , [4](https://stackoverflow.com/q/9842372/14608750) — Toddleson, Jun 18 '21 at 16:28
Some more: [5](https://stackoverflow.com/q/21074874/14608750) , [6](https://stackoverflow.com/q/34643849/14608750) , [7](https://stackoverflow.com/q/16268911/14608750) — Toddleson, Jun 18 '21 at 16:33
Er... why loop? Use [Autofilter](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) — Siddharth Rout, Jun 18 '21 at 16:48
If you have this code from YouTube, you should look a better channel. Someone using `Select` and uses unqualified ranges is clearly not an experienced Excel-VBA programmer. Your code fails, btw, because you don't switch back ("select) to the datasheet. But for the sake of the SO community, use your worksheet variables and qualify your ranges instead of relying on ActiveSheet. — FunThomas, Jun 18 '21 at 17:38

score 0 · Answer 1 · answered Jun 19 '21 at 02:14

A VBA Lookup

I'm keeping it close to the initial idea. It can be improved on multiple accounts e.g. by using arrays, AutoFilter, AdvancedFilter, and whatnot.
Feel free to rename the variables back to their initial names. The only new variable is dRow which keeps track of the current destination row so you don't need the '...(xlup).Offset(1) business'. Note the dRow = dRow + 1.
Most of the time you don't want to use Select or Activate. Qualify your ranges instead i.e. note the sws. and dws. in front of Range, Cells and Rows (Each range 'belongs' to a worksheet). This should be your most important lesson learned from this code.

A Quick Fix

Option Explicit

Sub SearchExtract()
    
    ' Source (DataSheet) - being read from
    Dim sws As Worksheet ' Worksheet
    Dim sRow As Long ' Current Row
    Dim slRow As Long ' Last row
    
    ' Destination (ReportSheet) - being written to
    Dim dws As Worksheet ' Worksheet
    Dim dRow As Long ' Current Row
    
    ' Other
    Dim SearchNumber As Long ' Criteria
    
    ' Source
    Set sws = Sheet4
    slRow = sws.Cells(sws.Rows.Count, "C").End(xlUp).Row
    
    ' Destination
    Set dws = Sheet3
    dws.Range("D5:F" & dws.Rows.Count).ClearContents
    dRow = 5
    SearchNumber = dws.Range("A1").Value
    
    ' Loop & Copy Values
    For sRow = 1 To slRow ' use 2 if you have headers in the first row
        If sws.Cells(sRow, "C").Value = SearchNumber Then
            dws.Range(dws.Cells(dRow, "D"), dws.Cells(dRow, "F")).Value _
                = sws.Range(sws.Cells(sRow, "A"), sws.Cells(sRow, "C")).Value
            dRow = dRow + 1
        End If
    Next sRow

End Sub

I cant define the finalrow properly

1 Answers1

A VBA Lookup