VBA using Excel's MATCH/INDEX function

[nvdunn]

HI there
I have 2 sets of data and the only unique identifiers I have in both data sets is:

FirstName
LastName
DOB

I am trying to match on these 3 criterias and also return their Address, Suburb, State, POst Code.

This is a very large data set and I am only expecting a small amount of matches however when I use this formula in excel {INDEX(CIDoB,MATCH($AQ2&$AR2&Q2,CIClientFName & CIClientLName & CIDoB,0)))} it just times out and takes FOREVER to update. SO i wanted to create a macro to loop through the data sets, identify the matches and return the names, DOB and addresses.



Address1
Suburb
State
Postcode

I want to do an IF statement that loops through over 400,000 rows that if FIRSTNAME, LASTNAME & DOB match from within my 2 named ranges, return all the data from sheet1 and append to the records on sheet 2 new.

Here is a sample of the Spreadsheet i am trying to loop through. I'm using named ranges for DOB FName LName for both worksheets. To get the one match in records, this is the Excel code i used
Q2 = Firstname on sheet 2
R2 = LastName on Sheet 2
P2 = DOB on Sheet 2
DOB = {INDEX(CADOB,MATCH($Q2&$R2&P2,CAFNAME & CALNAME & CADOB,0)))}
Add= {INDEX(CAAdd,MATCH($Q2&$R2&P2,CAFNAME & CALNAME & CADOB,0)))}
Suburb = {(INDEX(CASub,MATCH($Q2&$R2&P2,CAFNAME & CALNAME & CIDoB,0)))) }
PC= {INDEX(CAPC,MATCH($Q2&$R2&P2,CAFNAME & CALNAME & CADOB,0)))}
State = {INDEX(CAState,MATCH($Q2&$R2&P2,CAFNAME & CALNAME & CADOB,0)))}

I can't work out how to upload my excel spreadsheet any hints?
Here's a screen shot

Mger Code Manager Phone MobilePhone Email Firstname Surname AddressDetails Suburb State PostCode Ph1 Mobile Premium DOB 12345 Paul Jones 0410000000 Joel Smith 222 Fake St PHESSANT NSW 2000 0422555777 5/10/1984 45678 SimonSmith 0410000001 Julie Broidy 32 Lee Pl ST IVES QLD 4022 0422555778 17/10/1943 12345 John Little 0410000002 Cherish Laman 12 Leonard Pl MARRICKVILLLE NSW 2122 0422555779 20/01/1986 222888 Noel Stevens 0410000003 Alisha Hayswoth 77 Smith Dr APPIN NSW 2560 0422555780 7/03/1971 12348 Tanya Hill 0410000004 Alisha Hudson 78 Smith Drive APPIN NSW 2560 0422555781 7/03/1971 12345 Paul Jones 0410000005 Rajeev Sharima 100 Qurnaia Road PARKVILLE NSW 2174 0422555782 1/07/1965 45678 SimonSmith 0410000006 Cherish Levi 4/8 Leonard Pl MARY NSW 2122 0422555783 20/01/1952 12345 John Little 0410000007 Brendan Foley 21 Arthur Street HORNSBY NSW 4740 0422555784 5/10/1984 222888 Noel Stevens 0410000008 Axel Whiting 25 Jersey St DEE WHY NSW 2099 0422555785 5/10/1984 12348 Tanya Hill 0410000009 Johnno Ruler 54 Gould Place WAHROONGA QLD 4740 0422555786 5/10/1984 <colgroup><col><col><col><col><col><col><col><col><col><col span="2"><col><col span="3"></colgroup><tbody> </tbody>

<tbody>
</tbody>

Sheet 2

Mger Code

Manager

MgerLastName

ClientID

ClientGivenName

ClientLastName

EntityName

IsPrimary

AddressLine1

AddressLine2

SuburbName

PostCode

State

Country

Email

DateOfBirth

Client2FirstName

Client2LastName

Client1 Match on DOB

Address1

Suburb

Postcode

State

111222

Paul

Jones

5554443

Joel

Smith

Yes

222 Fake Street

PHESSANT

2000

NSW

AUSTRALIA

5/10/1984

Joel

Smith

111222

Paul

Jones

5554443

Julie

Broidy

Yes

32 Lee Place

ST IVES

4022

QLD

AUSTRALIA

17/10/1943

Julie

Broidy

111222

Paul

Jones

5554443

Cherish

Laman

Yes

12 Leonard Place

MARRICKVILLLE

2122

NSW

AUSTRALIA

yes@yahoo.com

20/01/1986

Cherish

Laman

111222

Paul

Jones

5554443

Alisha

Hayswoth

Yes

77 Smith Drive

APPIN

2560

NSW

AUSTRALIA

7/03/1971

Alisha

Hayswoth

7/03/1971

77 Smith Dr

APPIN

2560

NSW

111222

Paul

Jones

5554443

MARY

HA

Yes

54 COLLEGE AVENUE

QUAKERS HILL

2529

NSW

AUSTRALIA

12/03/1959

MARY

HA

111222

Paul

Jones

5554443

WENDY

HANS

No

5 BRISBANE STREET

BRISBANE

4000

QLD

AUSTRALIA

13/03/1967

WENDY

HANS

111222

Paul

Jones

5554443

WENLI

HA

No

54 JONES AVE

BLACKBUTT

2529

NSW

AUSTRALIA

13/03/1967

WENLI

HA

111222

Paul

Jones

5554443

DANNY WAI KAI

CATANIA

Yes

10 POLARIS PLACE

REEVSBY

2222

NSW

AUSTRALIA

9/09/1949

DANNY

CATANIA

111222

Paul

Jones

5554443

JOHNEE

CATA

Yes

10 UPPER BEACH Street

Balgowlah

2766

NSW

AUSTRALIA

9/09/1949

JOHNEE

CATA

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Many thanks for all your help,
Nina

 

[Mohammad Basem]

Hi nvdunn,

You have provided many formulae with many Names, but unfortunately it is still not very much clear.

I would like to suggest that you give an example about what do you expect the VBA code to do. You have posted sample data, so you have to give more details about the named ranges that should be compared with and sample data of the expected results.

Also, use references from the sample data you have provided. For example, you have mentioned a field name LASTNAME, which does not exist. I think it is Surname, right?

To post sample file, upload it to any cloud drive (Dropbox, Google Drive, OneDrive, MediaFire…), make it shared and post the link.

 

[ttray33y]

try this on your Sheet1

''''''''''Main Function''''''''''''''''''''By: Edu Alester A. Otarra''''''''''
'''''''''December 2015''''''''''''
Sub EXTA()


Application.ScreenUpdating = False


'Declare variables "DIMS" for easy debudding
Dim DOB As Variant
Dim cname1 As String
Dim cname2 As String
Dim lastrow As Long
Dim i As Long
Dim wsheet As Worksheet
Dim dbase As Worksheet




'Set your variable values
Set dbase = ActiveWorkbook.Sheets("dbase")
Set wsheet = ActiveWorkbook.ActiveSheet
wsheet.Range("A2:J20000").ClearContents
cname1 = wsheet.Range("A1").Value
cname2 = wsheet.Range("B1").Value
lastrow = dbase.Cells(Rows.Count, 1).End(xlUp).Row


    


    DOB = wsheet.Range("C1").Value






'Start Row to Loop
For i = 2 To lastrow
    'Condition before Loop
    If dbase.Cells(i, 6) = cname1 And dbase.Cells(i, 7) = cname2 And dbase.Cells(i, 15) = DOB Then
        With dbase
            .Range(.Cells(i, 8), .Cells(i, 11)).Copy Destination:=wsheet.Range("A2000").End(xlUp).Offset(1, 0)
        End With
    End If
    
'Next Row to Loop
Next i




    
    Range("A1").Select


Application.ScreenUpdating = True


End Sub

 

[ttray33y]

or this,
note this is just a sample loop.

''''''''''Main Function''''''''''''''''''''By: Edu Alester A. Otarra''''''''''
'''''''''December 2015''''''''''''
Sub EXTA()


Application.ScreenUpdating = False


'Declare variables "DIMS" for easy debudding
Dim DOB As Variant
Dim cname1 As String
Dim cname2 As String
Dim lastrow As Long
Dim i As Long
Dim wsheet As Worksheet
Dim dbase As Worksheet


'Set your variable values
Set dbase = ActiveWorkbook.Sheets("dbase")
Set wsheet = ActiveWorkbook.ActiveSheet
wsheet.Range("H2:K20000").ClearContents
cname1 = wsheet.Range("E2").Value
cname2 = wsheet.Range("F2").Value
lastrow = dbase.Cells(Rows.Count, 1).End(xlUp).Row


    DOB = wsheet.Range("G2").Value
    
'Start Row to Loop
For i = 2 To lastrow
    'Condition before Loop
    If dbase.Cells(i, 6) = cname1 And dbase.Cells(i, 7) = cname2 And dbase.Cells(i, 15) = DOB Then
        With dbase
            .Range(.Cells(i, 8), .Cells(i, 11)).Copy Destination:=wsheet.Range("H2000").End(xlUp).Offset(1, 0)
        End With
    End If
    
'Next Row to Loop
Next i
    
    Range("A1").Select


Application.ScreenUpdating = True


End Sub

 

[ttray33y]

be sure to make a copy of your XL before running any Macro as theres no Undo after running a macro

 

[nvdunn]

Thank you so much for your help ttray33y that works well if I compare line by line. My problem is that I have 2 large data sets and the names will not be in order to match on, hence why I was trying to match the data using an Array range formula.

This is how I tweaked your code:



''''''''''Main Function''''''''''''''''''''By: Edu Alester A. Otarra''''''''''
'''''''''December 2015''''''''''''
Sub EXTA()




Application.ScreenUpdating = False




'Declare variables "DIMS" for easy debudding


Dim DOB As Variant
Dim cname1 As String
Dim cname2 As String
Dim lastrow As Long
Dim i As Long
Dim j As Long
Dim wsheet As Worksheet
Dim dbase As Worksheet




'Set your variable values
Set dbase = ActiveWorkbook.Sheets("dbase")
Set wsheet = ActiveWorkbook.ActiveSheet
'wsheet.Range("H2:K20000").ClearContents
'cname1 = wsheet.Range("E2").Value
'cname2 = wsheet.Range("F2").Value
'DOB = wsheet.Range("P2").Value
lastrow = dbase.Cells(Rows.Count, 1).End(xlUp).Row




j = 2

'Start Row to Loop
For i = 2 To lastrow 'row counter for CI Dbase info
'Condition before Loop
cname1 = wsheet.Cells(j, 5).Value
cname2 = wsheet.Cells(j, 6).Value
DOB = wsheet.Cells(j, 16).Value
If dbase.Cells(i, 6) = cname1 And dbase.Cells(i, 7) = cname2 And dbase.Cells(i, 15) = DOB Then
'MsgBox "MATCH"

With dbase
.Range(.Cells(i, 8), .Cells(i, 11)).Copy Destination:=wsheet.Range("AD2000").End(xlUp).Offset(1, 0)
End With
End If

j = j + 1 'increment to loop through each row
'Next Row to Loop
Next i

Range("A1").Select




Application.ScreenUpdating = True




End Sub


To resolve my issue, do I need to compare the information in 2 temporary arrays? i'm just not sure how i can analyse 2 sets of data when the matches will never occur on the same line. In my example, i made the matches appear in the same order (Stupid example sorry) but in reality I need to compare 2 data sets, of varying rows/columns and the matches will never be in the same row so can I use named ranges to try and match? I could do it in excel by using the excel function DOB = {INDEX(CADOB,MATCH($Q2&$R2&P2,CAFNAME & CALNAME & CADOB,0)))} whereby CADOB = ClientA DOB matching FirstName, LastName and DOB cells.

Thanks again for all your help you've got me thinking. I'm sure this is solveable.
many thanks
Nina