Compiling data from different worksheets based on a criteria

[xlbaby]

The situation I have is unique and I need you guys help on resolving it.

I have two sets of data files:

1. First file has a lot of details such as the credit card number, the begin and expiry date of the credit card, outstanding balance, maximum balance available, current balance available, customer name and a customer relationship number. This customer relationship number is a unique number and is never assigned to another customer.
2. Second file has additional details such as the customer name, bank account number, current account balance, Loan application Yes/No, Phone number, address, e-mail id and customer relationship number. This customer relationship number is the same as the one on the first file.
   For e.g. If customer XYZ has been assigned a relationship number of 23675 in the first file, that same customer relationship number is reported for XYZ on file 2.

I have a separate file saved as Masterfile where the first tab is named as” Compiled data”. What I need is a macro which will pull the necessary information from the first and second file based on the customer relationship number.

This master file has all the headings reported on first and second file. The macro needs to consolidate the details from the first and second file based on the customer relationship number. The macro also has to make sure that the right details are pulled from the right column.

For e.g. if phone number of XYZ is on column L of the 2^nd file and credit card number is on column G of the 1^st file, the macro should pull these two details from the 1^st and 2^nd file and compile it under the same headings within “compiled data” tab of Masterfile. One thing I should say is that Credit card number and phone number will not be in column L and column G in Masterfile. The credit card number is in column C and phone number is in column N as shown below. I am not sure whether this information is relevant but I just wanted to share it with you.

A

B

C

D

E

F

G

H

I

J

K

L

M

N

Customer Relationship Number

Customer name

address

Credit Card Number

Bank Account Number

Begin Date

Loan Application Yes/No

Expiry Date

Outstanding Balance

Maximum Balance

Current Balance

Current Account Balance

e-mail id

Phone number

23675

XYZ

ABC Villa, DEF street, US

1234-56-78-9000

686394698

9/24/2016

No

9/24/2020

20000

100000

80000

174720

xxx@hjtu@thisistest.com

1-212-00-000

First and second file

First and second file

Second file

First file

Second file

First file

second file

First file

First file

First file

First file

second file

second file

second file

<tbody>
</tbody>

I hope I made it clear for you guys. Please let me know if you require any additional information.

 

[mumps]

It is always easier to help and test possible solutions if we could work with your actual files. Perhaps you could upload a copy of your 3 files to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[xlbaby]

mumps,

I have uploaded the files in dropbox. I am giving you the links below:

File 1: https://www.dropbox.com/s/j2fiv8hiellj4n6/File 1.xlsm?dl=0
File 2: https://www.dropbox.com/s/qlttj3a0qq5bt2a/File 2.xlsm?dl=0
masterfile: https://www.dropbox.com/s/tcj5pe3rvvdqw7z/Masterfile.xlsm?dl=0

In the mastefile, on row 18, I have put the references as to from which file and which column I needs the details. I will be more than happy to give you more information if it will help you.

Thank you for your help on this.

 

[MickG]

With all 3 workbooks open, try this in "Masterfile sheet "Compileddata"

[COLOR="Navy"]Sub[/COLOR] MG25Sep37
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] Range, File1 [COLOR="Navy"]As[/COLOR] Range, File2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.ScreenUpdating = False
[COLOR="Navy"]With[/COLOR] Workbooks("Masterfile.xlsm").Sheets("Compileddata")
 [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = Dn: [COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]Set[/COLOR] File1 = Workbooks("File 1.xlsm").Sheets("sheet 1").Range("A1").CurrentRegion
        File1.NumberFormat = "@"
    [COLOR="Navy"]Set[/COLOR] File2 = Workbooks("File 2.xlsm").Sheets("sheet 1").Range("A1").CurrentRegion
        File2.NumberFormat = "@"
        oMax = Application.Max(File1.Rows.Count, File2.Rows.Count)
        Rng.Resize(oMax).NumberFormat = "@"
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] File1.Rows(1).Cells
        [COLOR="Navy"]If[/COLOR] Dic.exists(Ac.Value) [COLOR="Navy"]Then[/COLOR]
            Dic(Ac.Value).Offset(1).Resize(File1.Rows.Count - 1).Value = _
            Ac.Offset(1).Resize(File1.Rows.Count - 1).Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] File2.Rows(1).Cells
        [COLOR="Navy"]If[/COLOR] Dic.exists(Ac.Value) [COLOR="Navy"]Then[/COLOR]
            Dic(Ac.Value).Offset(1).Resize(File2.Rows.Count - 1).Value = _
            Ac.Offset(1).Resize(File2.Rows.Count - 1).Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
Application.ScreenUpdating = True
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mumps]

Make sure that all 3 workbooks are open. Change the column header in the Master file, column G, from "Loan Application Yes/No" to "Loan Application" so that it matches the corresponding column header in File2.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim wsFile1 As Worksheet
    Set wsFile1 = Workbooks("File 1.xlsm").Sheets("Sheet 1")
    Dim wsFile2 As Worksheet
    Set wsFile2 = Workbooks("File 2.xlsm").Sheets("Sheet 1")
    Dim CRN As Range
    Dim foundCRN As Range
    Dim Header As Range
    Dim foundHeader As Range
    wsFile1.Range("A2:B" & wsFile1.Range("A" & Rows.Count).End(xlUp).Row).Copy Sheets("Compileddata").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each CRN In Range("A2:A" & LastRow)
        Set foundCRN = wsFile1.Range("A:A").Find(CRN, LookIn:=xlValues, lookat:=xlWhole)
        For Each Header In Range("C1:N1")
            Set foundHeader = wsFile1.Rows(1).Find(Header, LookIn:=xlValues, lookat:=xlWhole)
            If Not foundHeader Is Nothing Then
                Cells(CRN.Row, Header.Column) = wsFile1.Cells(foundCRN.Row, foundHeader.Column)
            End If
        Next Header
    Next CRN
    For Each CRN In Range("A2:A" & LastRow)
        Set foundCRN = wsFile2.Range("A:A").Find(CRN, LookIn:=xlValues, lookat:=xlWhole)
        For Each Header In Range("C1:N1")
            Set foundHeader = wsFile2.Rows(1).Find(Header, LookIn:=xlValues, lookat:=xlWhole)
            If Not foundHeader Is Nothing Then
                Cells(CRN.Row, Header.Column) = wsFile2.Cells(foundCRN.Row, foundHeader.Column)
            End If
        Next Header
    Next CRN
    Application.ScreenUpdating = True
End Sub

Place the macro in a regular module in the Master workbook and run it from there. Before you run the macro, make sure the "Compileddata" sheet contains only the headers with no data below.

 

[xlbaby]

mumps and MickG,

First of all apologies for the delayed reply. I was stuck in my work...

Both of your codes worked perfectly fine. It worked like a charm.

@mumps,

When I tried running your code in my client file, the macro throws up an error. When it clicked on "debug", it highlighted a section of the code. I have highlighted the error in the BLUE font.

For Each CRN In Range("A2:A" & LastRow)
Set foundCRN = wsFile2.Range("A:A").Find(CRN, LookIn:=xlValues, lookat:=xlWhole)
For Each Header In Range("C1:GF1")
Set foundHeader = wsFile2.Rows(1).Find(Header, LookIn:=xlValues, lookat:=xlWhole)
If Not foundHeader Is Nothing Then
Cells(CRN.Row, Header.Column) = wsFile2.Cells(foundCRN.Row, foundHeader.Column)

Can you help me in identifying what is the issue over here? I really appreciate your help.

 

[mumps]

I downloaded the three files you posted in Post# 3 and ran the macro I suggested. It worked properly without any errors. Are you using the same three files as posted or are you using the macro on different files? If you are using the macro on different files, please post the actual files you are using.

 

[xlbaby]

Thank you mumps.

I agree your macro was working on the files which was uploaded to the Dropbox. However, when I am using the macro on the my actual files, it throws up the error where I highlighted. Also, unfortunately, I cannot upload the actual files as it has some personal and sensitive data.

However, if you can explain me what that highlighted code does, I can try running it again and let you know what might be causing this issue.

 

[mumps]

It is difficult to suggest a solution without seeing how your data is organized. Can you perhaps replace the personal and sensitive data with generic data. The sample files would only need enough data to give an idea of how your data is organized. Here is the code with explanatory comments:

For Each CRN In Range("A2:A" & LastRow) 'loops through the values in column A of File1
        Set foundCRN = wsFile2.Range("A:A").Find(CRN, LookIn:=xlValues, lookat:=xlWhole) 'finds each value from File1 in column A of File2
        For Each Header In Range("C1:N1") 'loops through the headers in row 1 of File1
            Set foundHeader = wsFile2.Rows(1).Find(Header, LookIn:=xlValues, lookat:=xlWhole) 'finds that header in row 1 of File2
            If Not foundHeader Is Nothing Then 'if the header is found in File2, the next line of code is executed
                Cells(CRN.Row, Header.Column) = wsFile2.Cells(foundCRN.Row, foundHeader.Column) 'copies the cell from File1 to File2
            End If
        Next Header
    Next CRN

 

[xlbaby]

Thanks for the explanation.

I have removed the data within the file and have uploaded the files I am using now. The link is below.

https://www.dropbox.com/sh/rjyfw64pewxtl4q/AACkMffmNCibGe-WDGvivrpaa?dl=0

Let me know if this suffices. Thank you again for your help.