Searching two workbooks for matching SSN's and then returning a cell two columns over (its an email).

[HappyChappy1558]

I am working on an automation that has the user select a workbook (a weekly report), copies the SSN's from that report to an existing workbook and formats it with them all with the "-" because the report does not already do that. I have this part done so far. What I need it to do from here is have the user select another workbook (through file explore, it will not already be open) and search a column to match SSN's. When it finds a match it will return the value in the cell two and three columns over to the right. These values will be email addresses. Ex. match value in cell A1 return A3 and A4. Lastly, it will paste these values to the original workbook that is already open.

I will concatenate the emails together and separate them by a ";" and have outlook generate a "copy and paste" email to those email address. I just need the part above to get the email addresses. Below is what I have so far.

Sub Get_Data_From_File()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim r As Range

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("D2:D30").Copy
ThisWorkbook.Worksheets("SelectFile").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If


Application.ScreenUpdating = False
With Range("A1").CurrentRegion
For Each r In .Cells
With r
.Value = Application.Text(.Value, "000-00-0000")
End With
Next r
End With
Application.ScreenUpdating = True

End Sub