Find matching data in two columns

[srmorgan]

I have two sets of data, one from a satellite hospital and the other from Central hospital.
I have to find occurrences where a patient has been discharged from the satellite hospital and admitted to the central hospital within three days.
I have three columns of data, (A to C and D to F) national ID, patient # and date of discharge or admission.
I have to take the national ID in column A, find a match in column D and calculate if the date in column F is three days or less than three days apart. So if a patient is discharged on October 1, and admitted by October 4th I have a match. If admitted before October 1 or after October 4th, it is not a match.
I have to find each pair and either put them in new columns to show the pairs.
A patient could be discharged more than once and a patient could be admitted more than once.
In the sample below the second and the sixth rows in column A would form a match with the third and the seventh row in column D

Thanks to all

Satellite    Centrai
National ID Patient Acct Date    National ID Patient Acct Date
28036 137508 5/29/2013    26777 14231035 2/28/2013
28036 312770 9/16/2013    54567 15148497 4/10/2013
42722 501921 9/16/2013    28036 21974999 9/17/2013
44649 614901 2/17/2013    28036 22747589 9/10/2013
74889 499947 11/19/2012    28036 22837406 6/5/2013
74889 720575 7/11/2013    44649 27225653 1/3/2013
74889 598366 7/22/2013    74889 27915706 7/14/2013
85510 332934 7/1/2013    74889 27977996 10/9/2013
85510 613532 8/15/2013    74889 32786163 7/2/2013
89517 482967 7/1/2013    14345  62566514 
5/29/2013

 

[Marc L]

Following easy to adapt code works with source table starting from A1​

and destination table to J1 each with 2 header rows (so data start in row #3) :​

Sub Central3DaysMatch()
    Dim Cel As Range
                            D& = 2
    Application.ScreenUpdating = False
    [J1].CurrentRegion.Offset(2).Clear
 
    With [A1].CurrentRegion
        For R& = 3 To .Rows.Count
            Set Cel = .Columns(4).Find(.Cells(R, 1).Value, , xlValues)
 
            If Not Cel Is Nothing Then
                A$ = Cel.Address
 
                Do
                    If Cel(, 3).Value2 >= .Cells(R, 3).Value2 And _
                       Cel(, 3).Value2 <= .Cells(R, 3).Value2 + 3 Then
                        D = D + 1
                        .Cells(R, 1).Resize(, 3).Copy Cells(D, 10)
                                 Cel.Resize(, 3).Copy Cells(D, 13)
                    End If
 
                    Set Cel = .Columns(4).FindNext(Cel)
                Loop Until Cel.Address = A
            End If
        Next
    End With
                       Set Cel = Nothing
    Application.ScreenUpdating = True
End Sub

Code well operates with no blank source row and source columns 3 & 6 date formatted …​

​

Like it !​