Excel VBA search value then return all records

Question

Hi,

I'm try to find all information on columns E, F & G of Sheet 2 are matched ID number on the cell B1 of Sheet 1.

Here is the Data on Sheet 2

Here is the result should return to Sheet 1 after the code is run

And here is the code, but I get an error messages of run-time error.

Sub FindInfo()

    Dim IDNumber As String

    Dim LastRow As Long

    Dim i As Integer

    IDNumber = Sheet1.Cells(1, 2)

    LastRow = Sheet2.Range("A1").End(xlDown).Row

    For i = 2 To LastRow

        If Sheet2.Range(Cells(i, 10)) = IDNumber Then 'ERROR OCCURRED ON THIS LINE

            Sheet2.Range(Cells(i, 5), Cells(i, 7)).Copy

            Sheet1.Range("C100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

        End If

     Next i

End Sub

Could you please help me solve this issue. Thanks in advance!

Tony

Answer 1

Here is a macro based on your screenshot. If the real layout is different, you'll have to modify the code.

Sub ExtractData()

    Dim s As Long

    Dim m As Long

    Dim t As Long

    Dim c As Long

    Dim dtmDate As Date

    Dim strName As String

    Application.ScreenUpdating = False

    ' Get the date

    dtmDate = Cells(4, 8).Value

    ' Find the corresponding column

    For c = 3 To 5

        If Cells(3, c).Value = dtmDate Then Exit For

    Next c

    ' Get the name

    strName = Cells(5, 8).Value

    ' Clear the target range

    Range("J5:K" & Rows.Count).ClearContents

    ' Initialize the target row

    t = 4

    ' Get the last source row

    m = Cells(Rows.Count, 1).End(xlUp).Row

    ' Loop through the source rows

    For s = 5 To m

        ' If the name matches ...

        If Cells(s, 1).Value = strName Then

            ' ... go to the next target row

            t = t + 1

            ' and copy the project and hours

            Cells(t, 10).Value = Cells(s, 2).Value

            Cells(t, 11).Value = Cells(s, c).Value

        End If

    Next s

    Application.ScreenUpdating = True

End Sub

Answer 2

If you use Cells, you have to specify the sheet:

           Sheet2.Range(Sheet2.Cells(i, 5), Sheet2.Cells(i, 7)).Copy

Alternatively, you can use

           Sheet2.Range("E" & i & ":G" & i).Copy

or

           Sheet2.Cells(i, 5).Resize(1, 3).Copy

Answer 3

Range(Cells(i, 10)) is a bit much. Cells(i, 10) is sufficient:

        If Sheet2.Cells(i, 10) = IDNumber Then

Answer 4

Range(Cells(i, 10)) is a bit much. Cells(i, 10) is sufficient:

        If Sheet2.Cells(i, 10) = IDNumber Then

Now I have an error on the next line.

heet2.Range(Cells(i, 5), Cells(i, 7)).Copy

Is it other way to solve this problem? I can't use the Vlook up since the I have to look from right to left.

Answer 5

If you use Cells, you have to specify the sheet:

           Sheet2.Range(Sheet2.Cells(i, 5), Sheet2.Cells(i, 7)).Copy

Alternatively, you can use

           Sheet2.Range("E" & i & ":G" & i).Copy

or

           Sheet2.Cells(i, 5).Resize(1, 3).Copy

Thanks for your quick response Han, it work but I have another problem. If the ID Number is 111111 then it's OK but if  it's equal to 222222, 333333 then the select range on Sheet 2 still active. How can I fix this problem? Please help.