Solved: find matching cells btwn 2 lists and copy related records

[zest1]

Hi,

I could use some help with a basic match formula. I have a list of Names in col. A and need to find an exact match in col. B. For any matches found, I need the related cells copied to a new third list. VBA would be great, though a simple formula would be fine too. I tried using Index/Match but coldn't get it to work.

Query list:
Col. A
John Doe
Mary Russell
etc…

Data list:
B - C - D - E - F
Name - Title - Company - Address - Ph#
John Doe - Architect - JD Design - 123 Main - 800-123-4567
John H. Doe - IT Consultant - JHD Tech - 321 High Rd - 800-789-4321
John R. Doe - Manager - JRD Mgmt Corp. - 99 East Ave. - 800-567-8999
Mary Russell - Instructor - JHD Tech - 321 High Rd - 800-789-4321
Mary J. Russell - Accountant - JRD Mgmt Corp. - 99 East Ave. - 800-567-8999

Result list:
H - I - J - K - L
Name - Title - Company - Address - Ph#
John Doe - Architect - JD Design - 123 Main - 800-123-4567
Mary Russell - Instructor - JHD Tech - 321 High Rd - 800-789-4321

Thanks for any help offered!

[Jacob Hilderbrand]

Try this macro.


Option Explicit

Sub Match()

Dim i As Long
Dim LastRow As Long
Dim Row As Long
Dim Cel As Range

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

'Determine the last used row in Col A
LastRow = Range("A65536").End(xlUp).Row

'Set the start row for transfering the data
Row = 2

'Clear old values
Range("H2:L65536").ClearContents

'Start main loop
For i = 2 To LastRow

'Skip Blanks
If Range("A" & i).Text <> "" Then

'Try to find a match
Set Cel = Range("B:B").Find(What:=Range("A" & i).Text, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)

'Check if there was a match
If Not Cel Is Nothing Then
Range("B" & Cel.Row & ":F" & Cel.Row).Copy Destination:=Range("H" & Row)
Row = Row + 1
End If
End If
Next i

ExitSub:

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Cel = Nothing

End Sub

[zest1]

Thanks a lot DRJ.

That’s exactly what I needed! And thanks for clearly commenting throughout the code.

Can you add one thing? Could you have the code insert the Query name in the Results list regardless of whether a match was found or not, so that non-matching names can be easily spoted.

Thanks again!

[Jacob Hilderbrand]

Try this.


Option Explicit

Sub Match()

Dim i As Long
Dim LastRow As Long
Dim Row As Long
Dim Cel As Range

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

'Determine the last used row in Col A
LastRow = Range("A65536").End(xlUp).Row

'Set the start row for transfering the data
Row = 2

'Clear old values
Range("H2:L65536").ClearContents

'Start main loop
For i = 2 To LastRow

'Skip Blanks
If Range("A" & i).Text <> "" Then

'Try to find a match
Set Cel = Range("B:B").Find(What:=Range("A" & i).Text, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)

Range("H" & Row).Value = Range("A" & i).Text

'Check if there was a match
If Not Cel Is Nothing Then
Range("C" & Cel.Row & ":F" & Cel.Row).Copy Destination:=Range("I" & Row)
End If
Row = Row + 1
End If
Next i

ExitSub:

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Cel = Nothing

End Sub

[Jacob Hilderbrand]

Also, since you want to list all the names anyway, you can use a VLookUp formula. It will be N/A if there is no match so you can do something like:

H2 = A2
I2 = IF(ISNA(VLOOKUP($H2,$B$2:$F$65536,2,FALSE)),"", VLOOKUP($H2,$B$2:$F$65536,2,FALSE))
J2 = IF(ISNA(VLOOKUP($H2,$B$2:$F$65536,3,FALSE)),"", VLOOKUP($H2,$B$2:$F$65536,3,FALSE))
K2 = IF(ISNA(VLOOKUP($H2,$B$2:$F$65536,4,FALSE)),"", VLOOKUP($H2,$B$2:$F$65536,4,FALSE))
L2 = IF(ISNA(VLOOKUP($H2,$B$2:$F$65536,5,FALSE)),"", VLOOKUP($H2,$B$2:$F$65536,5,FALSE))

Then Fill Down.

[zest1]

Fantastic!

Thanks a lot DRJ

:) :)

[Jacob Hilderbrand]

You're Welcome :beerchug:

Take Care

[zest1]

Hi,
sorry for revisiting this "solved" thread, but I'd like to use the above "Matching" code for another similar Find & Copy situation.

Rather than copying the first matching entries found in column A of the list, I need to find the entry having the most recent date (there may be several different dates for an entry) and copy that one over.

The data structure is identical as the previous example, with column B being the Date column.

How do I do this?