Find a match and paste rows to a new sheet

[nike]

Hi,


I need help on creating a macro to compare column A in 2 different sheets, and if there's a match to create another worksheet to paste all the rows that matched column A. Thank you in advance!

I just put the comma to distinguish the columns for the example below.


EXAMPLE:


Sheet1
COLUMN A
1
ORANGE
CAT




SHEET2
A, B, C, D
1, MAPLE, STREET, CALIFORNA
1, MAPLE, STREET, CALIFORNA
ORANGE, APPLE, FRUIT, HIGHWAY
ORANGE, VEGGIE, GREEN, HIGHWAY
CAT, DOG, PET, ADOPT



SHEET3 (MATCHED COMBOS) OUTPUT
A, B, C, D
1, MAPLE, STREET, CALIFORNA
1, MAPLE, STREET, CALIFORNA
ORANGE, APPLE, FRUIT, HIGHWAY
ORANGE, VEGGIE, GREEN, HIGHWAY

 

[JLGWhiz]

See if this works for you.

Sub makeMatchLixt()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range, fn As Range, Adr As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("sheet2")
Sheets.Add After:=ThisWorkbook.Sheets(Sheets.Count)
Set sh3 = ActiveSheet
    For Each c In sh1.Range("A1", sh1.Cells(Rows.Count, 1).End(xlUp)) 'Assumes no header.  If header, change to "A2"
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                Adr = fn.Address
                Do
                    fn.EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
                    Set fn = sh2.Range("A:A").FindNext(fn)
                Loop While fn.Address <> Adr
            End If
        Set fn = Nothing
    Next
End Sub

 

[nike]

Hi JLGWhiz,

It works! Thank you so much! I just have one issue, the output starts on A2, even when i changed it to A2 for the header. If it's A2 it doesn't include the header and it starts on A2, but when i change it to A1, it includes the header but also starts in A2. It's not a big deal, i can just delete the top row, but if you can fix it, i'd appreciate it. Thanks again!

 

[JLGWhiz]

Hi JLGWhiz,

It works! Thank you so much! I just have one issue, the output starts on A2, even when i changed it to A2 for the header. If it's A2 it doesn't include the header and it starts on A2, but when i change it to A1, it includes the header but also starts in A2. It's not a big deal, i can just delete the top row, but if you can fix it, i'd appreciate it. Thanks again!

Sub makeMatchLixt2()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range, fn As Range, Adr As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("sheet2")
Sheets.Add After:=ThisWorkbook.Sheets(Sheets.Count)
Set sh3 = ActiveSheet
    For Each c In sh1.Range("A1", sh1.Cells(Rows.Count, 1).End(xlUp)) 'Assumes no header.  If header, change to "A2"
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                Adr = fn.Address
                Do
                    If sh3.Cells(1, 1) = "" Then
                        fn.EntireRow.Copy sh3.Range("A1")
                    Else
                        fn.EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
                    End If
                    Set fn = sh2.Range("A:A").FindNext(fn)
                Loop While fn.Address <> Adr
            End If
        Set fn = Nothing
    Next
End Sub

 

[nike]

Hi JLGWhiz,

The code works great, can this code below be added to your code to be able to do vlookup right after the output, on the same sheet? Thanks!

Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "General"
Range("D1").Select
ActiveCell.FormulaR1C1 = "STATE ID"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],PREP!C[-3]:C,4,0)"
Selection.AutoFill Destination:=Range("D2:D91")
Range("D2:D91").Select
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
End Sub