Copy data from a file based on comparison between two different workbooks

[RIC63]

I have two workbooks, one -Source.xls- and a second one -Destination.xlsm-, I must compare data of column A (for each rows) of Source, with data of column C on Destination and every time a match is found, the number present on column E of Source will be copied on column J on Destination -on the same row where the match is occourred.


I will appreciate any support12842

[Yongle]

Try this. The code that does the work is very short - the last 6 lines!. Uses Vlookup to look up the values in source file and matches to destination file, to identify what needs copying back to destination file. The rest sets up all the variables and ranges etc.

Sub Copy_with_VLookup()
'open the 2 files
Workbooks.Open Filename:="D:\??\??\destination.xlsm" '<your file name and path
Workbooks.Open Filename:="D:\??\??\source.xlsx" '<your file name and path
'set up variables
Dim RngDestination As Range, RngSource As Range
Dim strDestination As String, strSource As String
Dim LastRowsDestination As Long, LastRowsSource As Long
'determine data range in file1
Windows("Destination.xlsm").Activate '<your file name
Sheets("Sheet1").Select '<your sheet name in Destination
LastRowsDestination = Cells(Rows.Count, 3).End(xlUp).Row
Set RngDestination = Range("C2:C" & LastRowsDestination)
'determine range to check values against in file 2
Windows("Source.xlsx").Activate '<your file name>
Sheets("Sheet1").Select '<your sheet name in Source
LastRowsSource = Cells(Rows.Count, 1).End(xlUp).Row
Set RngSource = Range("A2:C" & LastRowsSource)


On Error Resume Next 'VLookup can be sulky and throw errors if it does not find a match

Windows("Destination.xlsm").Activate '<your file name
Sheets("Sheet1").Select '<your sheet name in Destination
For c = 2 To LastRowsDestination
strSource = blank
strDestination = Cells(c, 3).Value
strSource = Application.WorksheetFunction.VLookup(strDestination, RngSource, 3, False)
Cells(c, 10).Value = strSource
Next c
End Sub

[RIC63]

Thanks a lot for your support Yongle ;-)

sincerely
riccardo

[karthikumar]

This Vlookup function affects the data if we want to copy from two excel sheets. So instead of Vlookup, please advice how to copy and paste in master sheet from source file if it matches.

[Yongle]

So that we can help you:
1 Post the actual code that you are using enclosed inside the code hashtags
(easiest way to do this is to paste the code, then select it, then click on the # icon (next to the quote bubble)
2 Attach copies of both the source workbook(with the 2 worksheets) and destination workbooks
(click on GoAdvanced and then the paperclip icon)
3 Provide details of what in which sheet(s) needs to match what in the other sheet(s) etc and where it is to be copied to

Please do not post any pictures or jpegs
If your files contain sensitive data, amend to make anonymous
If your files are big, remove some of the lines and any non-relevant worksheets - just leave a sample of relevant data in each of the files

thanks

[karthikumar]

So that we can help you:
1 Post the actual code that you are using enclosed inside the code hashtags
(easiest way to do this is to paste the code, then select it, then click on the # icon (next to the quote bubble)
2 Attach copies of both the source workbook(with the 2 worksheets) and destination workbooks
(click on GoAdvanced and then the paperclip icon)
3 Provide details of what in which sheet(s) needs to match what in the other sheet(s) etc and where it is to be copied to

Please do not post any pictures or jpegs
If your files contain sensitive data, amend to make anonymous
If your files are big, remove some of the lines and any non-relevant worksheets - just leave a sample of relevant data in each of the files

thanks

I am posting my code here....


Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As LongDim myname As String
Dim mysegment As String
lastrow1 = wb3.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To lastrow1
myname = wb3.Sheets(1).Cells(i, "A").Value
mysegment = wb3.Sheets(1).Cells(i, "B").Value
Wb2.Sheets(1).Activate
lastrow2 = Wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


For j = 2 To lastrow2


If Wb2.Sheets(1).Cells(j, "A").Value = myname And Wb2.Sheets(1).Cells(j, "B").Value = mysegment Then
wb3.Sheets(1).Activate
wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M")).Copy
Wb2.Sheets(1).Activate
Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")).Select
ActiveSheet.Paste
End If


Next j
Application.CutCopyMode = False
Next i

The above code is working fine. However, it is taking so much time (approximately 1 hour) if master sheet is having 60,000 rows.

Please guide me to make this code as faster one.

Thanks in advance.

[Yongle]

Try this
Speeded up by
- deactivating screen update
- removed copy&paste and replaced with cell1 = cell2
- removed worksheet activate

Should be a lot faster for you




Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Dim mysegment As String


lastrow1 = wb3.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False


For i = 2 To lastrow1
myname = wb3.Sheets(1).Cells(i, "A").Value
mysegment = wb3.Sheets(1).Cells(i, "B").Value
lastrow2 = Wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For j = 2 To lastrow2
If Wb2.Sheets(1).Cells(j, "A").Value = myname And Wb2.Sheets(1).Cells(j, "B").Value = mysegment Then
Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")) = wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M"))
End If

Next j

Next i
Application.ScreenUpdating = True

[karthikumar]

Try this
Speeded up by
- deactivating screen update
- removed copy&paste and replaced with cell1 = cell2
- removed worksheet activate

Should be a lot faster for you




Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Dim mysegment As String


lastrow1 = wb3.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False


For i = 2 To lastrow1
myname = wb3.Sheets(1).Cells(i, "A").Value
mysegment = wb3.Sheets(1).Cells(i, "B").Value
lastrow2 = Wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For j = 2 To lastrow2
If Wb2.Sheets(1).Cells(j, "A").Value = myname And Wb2.Sheets(1).Cells(j, "B").Value = mysegment Then
Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")) = wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M"))
End If

Next j

Next i
Application.ScreenUpdating = True


Thanks for your prompt support.

I have got run time error '1004' as "Application-defined or object defined error" when i tried to cross this code

Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")) = wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M"))

Please resolve it.

I am looking for your support.

Thank you

[Yongle]

My error

Replace


Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")) = wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M"))

with


wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M")).Copy
wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")).PasteSpecial xlAll

[karthikumar]

My error

Replace


Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")) = wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M"))

with


wb3.Sheets(1).Range(Cells(i, "C"), Cells(i, "M")).Copy
wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")).PasteSpecial xlAll


Thanks again...

Now i got same error message when i try to pass this code

Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")).PasteSpecial xlAll

I am looking forward for your support

[Yongle]

Please post the WHOLE subroutine (the current one with the error) for me (incl Sub and End Sub)

I am puzzled because


Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")).PasteSpecial xlAll

is the same as your original code

Wb2.Sheets(1).Range(Cells(j, "C"), Cells(j, "M")).Select
ActiveSheet.Paste



thanks

[karthikumar]

I have modified my code for updating the sheet 2 based on sheet 1. However, the code is working fine for me. The problem is taking time if sheet 1 has more rows.


Sub updatesheet()Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long, wb As Workbook
Dim myname As String
Dim mysegment As String
Set wb = ActiveWorkbook
lastrow1 = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To lastrow1
myname = wb.Sheets(2).Cells(i, "A").Value
mysegment = wb.Sheets(2).Cells(i, "B").Value
wb.Sheets(1).Activate
lastrow2 = wb.Sheets(2).Range("A" & Rows.Count).End(xlUp).Row


For j = 2 To lastrow2


If wb.Sheets(1).Cells(j, "A").Value = myname And wb.Sheets(1).Cells(j, "B").Value = mysegment Then
wb.Sheets(1).Activate
wb.Sheets(1).Range(Cells(i, "C"), Cells(i, "M")).Copy
wb.Sheets(2).Activate
wb.Sheets(2).Range(Cells(j, "C"), Cells(j, "M")).Select
ActiveSheet.Paste
End If


Next j
Application.CutCopyMode = False
Next i


End Sub




Please resolve it and make this code for faster one.

Thanks in advance for your help.

[Yongle]

Thanks. Puzzle solved.
I will modify the code above for you later today when back at my PC.


I have modified my code for updating the sheet 2 based on sheet 1. However, the code is working fine for me. The problem is taking time if sheet 1 has more rows.
- which cells/rows/columns etc are being modified in sheet 2
- which cells/rows/columns in sheet 1 are being used for this?

Yon

[karthikumar]

Thanks. Puzzle solved.
I will modify the code above for you later today when back at my PC.


- which cells/rows/columns etc are being modified in sheet 2
- which cells/rows/columns in sheet 1 are being used for this?

Yon

Thanks for your note.

Let me explain you in detail.

Assuming that Sheet 1 has data in A to M columns. If columns A and B of sheet1 matches with column A and B of sheet2, Columns C to M data will be copied from sheet 1 and pasted it in sheet 2 of respective rows.

Example:

Sheet 1



A
1
10


B
2
20


C
3
30




Sheet 2



A
1



N
5



C
3




Once you run the code,

Sheet 2



A
1
10


N
5



C
3
30




Hope, you can understand from the above table.

Please note that if sheet 1 or sheet 2 has more rows like 10,000, this code will be very slow.

Thanks in advance.

[Yongle]

This will be faster.
For you to test I have only used 2 worksheets but it will be easy to add the 3rd worksheet later.
(you will see that wk3 is set but not used etc)

For you to test
Attached is workbook containing macro below and a (separate) macro to generate test data.
Open the workbook (it contains no data) and run macro Test (which runs both macros)
You will be asked to input the number of test rows for sheet1 and for sheet2.
I suggest you input 100 for the first test - just to demonstrate that the macros work on your machine.
Then run the macro again with a 1000, then with 10000
Please let me know how long the timer (see below) says it takes to run for test1, 2 and 3

Changes made to speed it up:
Stopped the screen from updating and the workbook from calculating
(writing data to screen often takes longer than for vba to generate it)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Copied values to be matched into two arrays
(single capture of all values - reading from array faster than from worksheet)
Array_1 = range1
Array_2 = range2
Concatenated the 2 items to be matched into a single string
(then only one comparison test, previously 2 X number of matches)
CompareString2 = Array_2(i, 1) & Array_2(i, 2)
Used a faster method to write the data to the worksheet
(faster than copy and paste)
ws1.Range("C" & j & ":M" & j).Copy Destination:=ws2.Range("C" & i & ":M" & i)

Timer
A timer has been added which times how long macro Z_Method takes to run

After you have tested, I will show you how to test with your data and if that is successful, how to add worksheet 3

Yon


Sub Z_Method()


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim range1 As Range, range2 As Range, range3 As Range
Dim Array_1() As Variant, Array_2() As Variant
Dim CompareString1 As String, CompareString2 As String
Dim StartTime, EndTime, Elapsed
StartTime = Timer

Set ws1 = ThisWorkbook.Worksheets("sheet1")
Set ws2 = ThisWorkbook.Worksheets("sheet2")
Set ws3 = ThisWorkbook.Worksheets("sheet3")
lastrow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row

'clear old values in sheet2
ws2.Range("C2:M" & lastrow2).Delete

Set range1 = ws1.Range("A1:B" & lastrow1)
Set range2 = ws2.Range("A1:B" & lastrow2)
'copy values from both ranges into array
Array_1 = range1
Array_2 = range2
'
For i = 2 To lastrow2
CompareString2 = Array_2(i, 1) & Array_2(i, 2)
For j = 2 To lastrow1
If Array_1(j, 1) & Array_1(j, 2) = CompareString2 Then
ws1.Range("C" & j & ":M" & j).Copy Destination:=ws2.Range("C" & i & ":M" & i)
End If
Next j
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

ws2.Range("C2").End(xlDown).Select
EndTime = Timer
Elapsed = EndTime - StartTime
MsgBox "Time to run macro =" & vbNewLine & Int(Elapsed) & " minutes " & Round((Elapsed - Int(Elapsed)) * 60, 0) & " seconds" & vbNewLine & vbNewLine & "(EXCLUDES time to generate test data)"
End Sub

[Yongle]

I just noticed I was a bit over enthusiastic and converted elapse minutes into seconds when they were already in seconds (final message box! :blush:blush:blush

I have amended it and attach a fresh copy of the file for you to use

[karthikumar]

Thank you so much...

You are genius....

It is working faster than mine... it is just awesome...

This is for your kind information that as of now i used this code for sheets having 1600 rows which resulted to complete within 10 sec.:yes:yes

I really appreciate your work reg this code.

Thank you so much once again.

[Yongle]

Glad to help
Unless there is something else that you need, please click on thread tools (at the top of the thread) and mark the thread as solved

​thanks

[karthikumar]

Hi,

I am new to this forum...I couldn't see the options as SOLVED in thread tools. (At the top of Thread tools > show printable version and unsubscribe from this thread)

Please guide me to select the options as required.

Thank you

[Yongle]

It is just above post#01


13423

[snb]

@Yongle

Much faster/simpler:


Sub Z_CreateSheets()
ReDim sn(InputBox(" for : SHEET1", "How many rows of test data do you want", 10000), 12)
ReDim sp(InputBox(" for : SHEET2", "How many rows of test data do you want", 10000), 12)

For j = 0 To UBound(sn)
For jj = 0 To UBound(sn, 2)
sn(j, jj) = IIf(j = 0, "Header " & jj + 1, IIf(jj > 1, "Data" & jj * 2, "Test " & j * 2))
Next
Next

For j = 0 To UBound(sp)
For jj = 0 To IIf(j = 0, UBound(sp, 2), 1)
sp(j, jj) = IIf(j = 0, "Header " & jj + 1, "Test " & j * 3)
Next
Next

Sheet4.Cells(1).Resize(UBound(sn) + 1, UBound(sn, 2) + 1) = sn
Sheet1.Cells(1).Resize(UBound(sn) + 1, UBound(sn, 2) + 1) = sn
Sheet5.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
Sheet2.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

NB. since this thread has been hijacked by Karthikumar, (s)he can't change it's status to 'solved'.

[karthikumar]

I have got error msg as Run time error '6' Overflow when I cross this code


For j = 2 To lastrow1

I try to use this code for sheet has more than 50,000 rows.

Please guide me to resolve this issue.

Thanks in advance

[Yongle]

@snb - very elegant. :bow:

[karthikumar]

Hi Yongle,

I have got an error msg as Runtime error "6": Overflow when i tried to run the code for sheets having more than 60,000 rows.

Exactly, i got error when i try to pass the code


For i = 2 To lastrow2

Please guide me to resolve this.

Thanks in advance.

[Yongle]

You could try to add the lines

Dim LastRow1 as long
Dim LastRow2 as long
at the beginning of the code
immediately below line:

Application.Calculation = xlCalculationManual


(I am guessing that VBA is treating both variables as type "Integer", whose maximum value is 32,767. So declaring those variables as "Long" allows them to hold values up to 2147483647. My guess is based on fact that with 10,000 rows VBA runs ok, but crashes with 60,000 rows. If you want to prove it - try running with 32,000 rows -should run ok, then try 33,000 rows -should crash)

[karthikumar]

I have already amended the code. However, I am still getting the same error as Run time error '6': Overflow

I am looking for your support

Thank you,

[Yongle]

Given that the code works fine up to 10,000 values it is clearly hitting a limit somewhere.


Please attach a workbook containing one worksheet with 100 rows with columns A to M

I assume that all the rows contain similar types of data and so only need a sample.
If you feel that the data is confidential - then amend it so that problem goes away.
Amend it so that the data still looks the same.
You only need to amend text fields - numbers are meaningless without understandable text.
So a name field like Peter Jones could be amended to AAAAAAA BBBBBBBBBB (same
for the whole column). Change your headings too.

I will test further when I receive a file with some real data in it from you.

thanks

[Yongle]

I tested the code with 70000 rows in sheet1 and 70000 rows n sheet2. On my PC it runs in 19 minutes (without errors)

Given that the error message occurs only on your machine, we need to work out what is different.

So a few questions:
1 Are you running my code without any modification?
2 Are you using my workbook?
3 Are you using my code to generate data (or are you testing with your data)?
4 Which version of Excel are you running?
5 Which version of windows are you running?

[karthikumar]

I tested the code with 70000 rows in sheet1 and 70000 rows n sheet2. On my PC it runs in 19 minutes (without errors)

Given that the error message occurs only on your machine, we need to work out what is different.

So a few questions:
1 Are you running my code without any modification?
2 Are you using my workbook?
3 Are you using my code to generate data (or are you testing with your data)?
4 Which version of Excel are you running?
5 Which version of windows are you running?

I would like to answer your questions

1. I am using your code without any modification.
2. No, I am using my workbook which has 90,000 rows data.
3. No, I am not using your code to generate data. Because I have already data.
4. I have excel 2013.
5. Windows 7

Thank you

[Yongle]

Now that you have established that the problem is happening outside my workbook when using your data,
you should be able to identify where the problem is by running a series of tests:

Test1
Use my workbook , my code (unmodified), my generated data, 90,000 rows
Does it crash? YES then run:
Test 2
Repeat the test reducing the rows by 5000 each time until it works

Test1
Use my workbook , my code (unmodified), my generated data, 90,000 rows
Does it crash? NO then run:
Test2
Copy and paste YOUR data into sheets1 and sheet2 of my workbook , my code (unmodified), and run macro Z_Method
Does it crash? YES - the problem is in your data
Does it crash? NO - the problem is solved

I notice that the number of rows that you are using has increased from 60000 to 90000. Is this a typing mistake?

[karthikumar]

Now that you have established that the problem is happening outside my workbook when using your data,
you should be able to identify where the problem is by running a series of tests:

Test1
Use my workbook , my code (unmodified), my generated data, 90,000 rows
Does it crash? YES then run:
Test 2
Repeat the test reducing the rows by 5000 each time until it works

Test1
Use my workbook , my code (unmodified), my generated data, 90,000 rows
Does it crash? NO then run:
Test2
Copy and paste YOUR data into sheets1 and sheet2 of my workbook , my code (unmodified), and run macro Z_Method
Does it crash? YES - the problem is in your data
Does it crash? NO - the problem is solved

I notice that the number of rows that you are using has increased from 60000 to 90000. Is this a typing mistake?

Thanks for your info.

I will test it and let you know.

I have used the code for sheets having 60,000 as well as 90,000 rows and got errors.

Thank you

[karthikumar]

Hi Yongle,

Your code is really working fine for sheets having 30,000 rows.

I did your tests.

Initially, i generated 90,000 rows data.....it resulted error.
Then i increased from 30,000 rows to 50,000...It is running without error. it took 12 minutes to complete with accurate answer.
But still I have got same error as Over flow for 90,000 rows data.

Can you suggest me to reduce the time for running macro?
Because more than 5 minutes is lengthy process. For example, source has 60,000 data which has 10 rows of updated data. master has more than 80,000 rows.

So, if macro takes more than 10 minutes to complete the process, it will not be good.

Please guide me to reduce the running time of macro if source has more than 50,000 rows.

Thanks in advance

[Yongle]

Did you run the tests in my workbook? Did you only use the auto-generated data?
I think the answer to these questions is YES. You only hit problems above 50,000 rows, and so that suggests the VBA is not the problem
I do not have any problems running these tests with many more rows. I am using Windows 7 and Excel 2010. And so again that suggests that VBA is not the problem
In order that I may see if there is anything more that I can do for you, please attach a copy of both the source and destination - 100 rows of each to your reply (click on GoAdvanced and then the paperclip icon)
I may have another solution but I must see the raw data before I begin

thanks

[Yongle]

The vba is doing a lot of work. It is checking every row in source against every row in destination.
With 80,000 rows in both files, the number of checks = 80,000 X 80,000 = 6.4 Billion checks!!!
That is why it is taking so long. So we must find a way to reduce the number of checks

Questions
Are the values in columnA (Source) unique? (or do some of the values repeat?)
Are the values in columnA (Master) unique ? (or do some of the values repeat?)

Raw data
In order that I may see if there is anything more that I can do for you, please attach a copy of both the Source and Master (100 rows of each) to your reply
(click on GoAdvanced and then the paperclip icon). I may have another solution but I must see the raw data before I begin

thanks