Loop Vlookup VBA?

[DSTRA]

Hello everyone,

I have this problem and I think a vlookup loop (VBA) will solve this problem. I haven’t found any solutions on google so it might be that vlookup isn’t the way to go, I don’t know ?.

this workbook has 3 sheets.

Sheet1: with a product list, 1 column.

Sheet2: with parts, 2 columns.

Sheet3: with a compiled list based on the data in sheet 1 and 2, 2 Columns.

The idea is for all products in sheet1 lookup their parts in sheet2, If a match, copy the row(s) to sheet 3.

So do this for all products in sheet1.

Note that 1 product could have several parts.

So it has to be vba so I can add it to a button.

I appreciate all help, i don’t have much VBA experience.

Thanks ?

Sheet1
Product
Product 2
Product 4

Sheet2
Product - Parts
Product1 Part1
Product2 Part1
Product2 Part2
Product3 Part1
Product3 Part2
Product4 Part1

Sheet3
Product - Parts
Product2 Part1
Product2 Part2
Product4 Part1

 

[Alex Blakenburg]

Give this a try:-

Sub ProductAdvancedFilter()

    Dim shtProd As Worksheet, shtParts As Worksheet, shtOut As Worksheet
    Dim lastRow As Long
    Dim critRng As Range, partsRng As Range, outRng As Range

    Set shtProd = Worksheets("Sheet1")
    Set shtParts = Worksheets("Sheet2")
    Set shtOut = Worksheets("Sheet3")
    
    With shtProd
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set critRng = .Range("A1:A" & lastRow)
    End With
    
    With shtParts
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set partsRng = .Range("A1:B" & lastRow)
    End With
    
    With shtOut
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set outRng = .Range("A1:B" & lastRow)
        outRng.Clear
        Set outRng = .Range("A1")
    End With
        
    partsRng.AdvancedFilter xlFilterCopy, critRng, outRng
       
End Sub

 

[DSTRA]

Give this a try:-

Sub ProductAdvancedFilter()

    Dim shtProd As Worksheet, shtParts As Worksheet, shtOut As Worksheet
    Dim lastRow As Long
    Dim critRng As Range, partsRng As Range, outRng As Range

    Set shtProd = Worksheets("Sheet1")
    Set shtParts = Worksheets("Sheet2")
    Set shtOut = Worksheets("Sheet3")
   
    With shtProd
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set critRng = .Range("A1:A" & lastRow)
    End With
   
    With shtParts
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set partsRng = .Range("A1:B" & lastRow)
    End With
   
    With shtOut
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set outRng = .Range("A1:B" & lastRow)
        outRng.Clear
        Set outRng = .Range("A1")
    End With
       
    partsRng.AdvancedFilter xlFilterCopy, critRng, outRng
      
End Sub

Dear Alex,

It works great, thanks a lot!

Danny

 

[Alex Blakenburg]

Hi Danny, thanks for letting me know. Glad I could help.