CODEWITHSUNDEEP
vbaexcel
RickymQrk
RickymQrk

Reputation: 3

Using value in sheet 1, search sheet 2 and return found value as row in sheet 3

The problem I have a pile of data in sheet 2. It's around 6k rows. I have some 437 I want to locate. These are specified in sheet 1 (Column A). For these I want to copy the whole row and place it in sheet 3. The value in sheet 1 can be found multiple times in sheet 2, I need them all.

My solution I have found VBA to search through it all. But it stops at 437.

 Public Sub findfak()

 Dim lastRowS1 As Long
 Dim lastRowS2 As Long
 Dim lastRowS5 As Long
 Dim i As Long
 Dim j As Long
 Dim tempS1 As Long
 Dim temps2 As Long
 Dim tempRow As Long

 lastRowS1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
 lastRowS2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

 Application.ScreenUpdating = False

     For i = 2 To lastRowS1
         tempS1 = Sheet1.Cells(i, 1).Value

         If Not IsError(Application.Match(tempS1, Sheet2.Range("A:A"), 0)) Then
             lastRowS5 = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
             Sheet2.Rows(i).EntireRow.Copy Destination:=Sheet5.Rows(lastRowS5 + 1)
         End If

     Next i

 Application.ScreenUpdating = True
 End Sub

Upvotes: 0

Views: 433

Answers (1)

findwindow
findwindow

Reputation: 3153

Try this.

Sub findfak()

Dim lastRowS1 As Long
Dim lastRowS2 As Long
Dim lastRowS5 As Long
Dim i As Long
Dim j As Long
Dim tempS1 As Variant
Dim temps2 As Long
Dim tempRow As Long

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

'change sheets as necessary
Set ws1 = WorkSheets("Sheet5")
Set ws2 = WorkSheets("Sheet6")
Set ws3 = WorkSheets("Sheet2")

lastRowS1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastRowS2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To lastRowS1

    tempS1 = ws1.Cells(i, 1).Value

    For j = 2 To lastRowS2

        If ws2.Cells(j, 1) = tempS1 Then
            lastRowS5 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
            ws2.Rows(j).EntireRow.Copy Destination:=ws3.Rows(lastRowS5 + 1)
        End If

    Next j

Next i

Application.ScreenUpdating = True

End Sub

Upvotes: 1

Related Questions