VBA to search for multiple values in one sheet then copy to another sheet

Hi there
Here’s the issue:

I have three sheets….
Sheet1 has the Data
Sheet 2 is blank
Sheet3 has the search Names {there are about 100 rows with name values}

I want to search Sheet1 for all occurrences of where the name values from Sheet3 might occur, and then copy them to Sheet2.
I have no idea where to start because I need the search to loop to search for the next name value from Sheet3.

I have attached an example of the workbook layout; however there is no code.
I know how to do a basic search and copy code, but I am unsure how this will work when the search value is held in 100+ rows on Sheet3.

Here’s a little sample of what I am trying to do…….


SHEET 1: (has many rows of data i need to search through)
SHEET 2: (is currently blank, and is where the output from the search will go)
SHEET 3: (has Coloum "A' filled with rows of names like DLPTPAYR or DLSYCNTY. These are table names, and I am searching a script from SHEET1 to see if these table names from SHEET3 appear on SHEET1 then copy them to SHEET2.

Sub compare()

On Error Resume Next

Set sh1 = Sheets("sheet1")
Set sh2 = Sheets("sheet3")
Set sh3 = Sheets("sheet2")

r1max = sh1.Range("a" & Rows.Count).End(xlUp).Row

r2 = 1
r3 = 2

While sh2.Cells(r2, 1) <> ""
  sk = sh2.Cells(r2, 1)
  For r1 = 1 To r1max
    j = 0
    j = WorksheetFunction.Find(sk, sh1.Cells(r1, 1))
    If j > 0 Then
      sh3.Cells(r3, 1) = j
      sh3.Cells(r3, 2) = sh1.Cells(r1, 1)
      r3 = r3 + 1
    End If
  Next
  r2 = r2 + 1
Wend

End Sub

Try this

Sub test()
    Dim a, i As Long, n As Long, myPtn As String
    myPtn = Join(Application.Transpose(Sheets("sheet3").Cells(1) _
    .CurrentRegion.Columns(1).Value), Chr(2))
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([\$\(\)\-\^\|\\\{\}\[\]\+\*\?\.])"
        myPtn = Replace(.Replace(myPtn, "\$1"), Chr(2), "|")
        .Pattern = myPtn
        For i = 1 To UBound(a, 1)
            If .test(a(i, 1)) Then
                n = n + 1: a(n, 1) = .Execute(a(i, 1))(0)
            End If
        Next
    End With
    If n > 0 Then Sheets("sheet2").Cells(1).Resize(n).Value = a
End Sub

I have now found that the data source is actually spread over multiple columns not just A.
Is that an issue?

Originally Posted by DanzaNZ

I have now found that the data source is actually spread over multiple columns not just A.
Is that an issue?

Sub test()
    Dim a, i As Long, ii As Long, myPtn As String, AL As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    myPtn = Join(Application.Transpose(Sheets("sheet3").Cells(1) _
    .CurrentRegion.Columns(1).Value), Chr(2))
    a = Sheets("sheet1").UsedRange.Value
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([\$\(\)\-\^\|\\\{\}\[\]\+\*\?\.])"
        myPtn = Replace(.Replace(myPtn, "\$1"), Chr(2), "|")
        .Pattern = myPtn
        For i = 1 To UBound(a, 1)
            For ii = 1 To UBound(a, 2)
                If .test(a(i, ii)) Then
                    AL.Add .Execute(a(i, ii))(0)
                End If
            Next
        Next
    End With
    If AL.Count Then Sheets("sheet2").Cells(1).Resize(AL.Count).Value = _
    Application.Transpose(AL.ToArray)
End Sub

Thank you Jindon
Truly amazing help!
Much appreciated!