Snasui Excel Forum

Code: Select all

Sub search2()
    i = 2
    o = 2
    j = 2
    
 Do
    Sheets("Sheet2").Range("a2").Value = Sheets("Sheet3").Cells(o, 2)
    Do
        If Range("a2") = Sheets("Sheet1").Cells(i, 1) Then
            For x = 1 To 7
             Sheets("Sheet2").Cells(j, x + 1) = Sheets("Sheet1").Cells(i, x + 1)
            Next
            j = j + 1
        End If
            i = i + 1
    Loop Until Sheets("Sheet1").Cells(i, 1) = ""
    Sheets("Sheet2").Range("a2:o500").ClearContents
    o = o + 1
    Loop Until Sheets("Sheet3").Cells(o, 2) = ""
  
End Sub

Code: Select all

Public Sub Search_II()
    Dim r As Range, vPO As Variant _
            , l2 As Long, l3 As Long, i As Long _
            , m As Integer, n As Integer
            
    With Sheets("sheet2")
        .Range("a2:h" & .Rows.Count).Clear
    End With
    
    'Find total row of PO
    With Sheets("sheet3")
        l3 = .Range("b" & .Rows.Count).End(xlUp).Row
    End With
    
    'Loop...start
    For i = 2 To l3
        With Sheets("sheet2")
            vPO = Sheets("sheet3").Cells(i, 2).Value
            l2 = .Range("b" & .Rows.Count).End(xlUp).Row + 1
            .Cells(l2, 1).Value = vPO
            .Cells(l2, 1).Interior.Color = .Cells(1, 1).Interior.Color
        End With
        With Sheets("sheet1")
            Set r = .Range("a1")
            m = WorksheetFunction.CountIf(.Range("a:a"), vPO)
            n = 0
                Do While n < m
                    Set r = .Range("a:a").Find(What:=vPO, After:=r, LookIn:=xlValues _
                        , lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext _
                        , MatchCase:=False)
                    r.Offset(0, 1).Resize(1, 7).Copy
                    l2 = Sheets("sheet2").Range("b" & Sheets("sheet2").Rows.Count). _
                            End(xlUp).Row + 1
                    Sheets("sheet2").Cells(l2, 2).PasteSpecial xlPasteValues
                    Sheets("sheet2").Cells(l2, 2).PasteSpecial xlPasteFormats
                    n = n + 1
                Loop
        End With
    Next i
    Application.CutCopyMode = False
End Sub

Code: Select all

Sub search2()
  Sheets("Sheet2").Range("a2:o500").ClearContents
    o = 2
    Do
       Sheets("Sheet2").Range("b" & Rows.Count).End(xlUp).Offset(1, -1) _
           .Value = Sheets("Sheet3").Cells(o, 2)
       i = 2
       j = Sheets("Sheet2").Range("b" & Rows.Count).End(xlUp).Offset(1, -1).Row
       Do
           If Sheets("Sheet2").Range("a" & Rows.Count).End(xlUp) = Sheets("Sheet1").Cells(i, 1) Then
               For x = 1 To 7
                    Sheets("Sheet2").Cells(j, x + 1) = Sheets("Sheet1").Cells(i, x + 1)
               Next
               j = j + 1
           End If
            i = i + 1
       Loop Until Sheets("Sheet1").Cells(i, 1) = ""
       o = o + 1
    Loop Until Sheets("Sheet3").Cells(o, 2) = ""
End Sub