Find the same value in column A in different sheet, then paste value in column B, but too long to process

[borntobe]

Hi,
I have 80,000 records in sheet1, and 10,000 records in sheet2.
What I want to do is that I have to find the same value in column A in sheet1 with column A in sheet2.
If I find the same value in column A in sheet1, then copy value in column A and column B in sheet2, then paste it into column D and E in sheet1.

sheet1 looks like below

	A	B	C	D	E
1
2	Item	Rate
3	7	0.023
4	8	0.0115
5	20	0.005
6	27	0.89

<tbody>
</tbody>

sheet2 looks like below

	A	B
1
2	Item	Rate
3	6	0.12
4	8	0.568
5	27	0.047
6	33	0.56

<tbody>
</tbody>

Expect results looks like below

	A	B	C	D	E
1
2	Item	Rate		Item from sheet2	Rate from sheet2
3	7	0.023
4	8	0.0115		8	0.568
5	20	0.005
6	27	0.89		27	0.047

<tbody>
</tbody>

So, I tried below vba code, but it took forever.

Set wsD = ThisWorkbook.Sheets("sheet1")
lrR = wsD.Cells(Rows.Count, 1).End(xlUp).Row   'col A


Set ws = ThisWorkbook.Sheets("sheet2")  
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row


With ws
    For m = 3 To lr        
                With wsD.Range("A3:A" & lrR)
                    For n =3 To lrR
                        If ws.Range("A" & m) = wsD.Range("A" & n) Then
                           ws.Range("A" & m & ":" & "B" & m).Copy
                      
                           wsD.Range("D" & n).PasteSpecial xlPasteValuesAndNumberFormats
                            GoTo skip
                            
                        End If
                    Next n
                End With
      
skip: 
    Next m
End With

Please advise me how to process this faster and easier way.
Thanks in advance.

 

[offthelip]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),
I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.

You problem is very easily solved by loading the data into two varaint arrays and writing the results out to a third array, so this code will over a thousand times faster than your code !!!
Note this code does not copy the formatting, this is best done afterwards if it is necessary by formatting the entire column
Note I have not tested this code.

Sub test()

With WorkSheets("sheet2")
lr = .Cells(Rows.Count, 1).End(xlUp).Row   'col A
inarr = Range(.Cells(1, 1), .Cells(lr, 2))
End With




With Worksheets("sheet1")
lrR = .Cells(Rows.Count, 1).End(xlUp).Row   'col A
Wdrarr = Range(.Cells(1, 1), .Cells(lrR, 1))
outarr = Range(.Cells(1, 4), .Cells(lrR, 5))



 For n = 3 To lrR
   For m = 3 To lr
        'If .Range("A" & m).Value = wsD.Range("A" & Then
                   
                        If inarr(m, 1) = Wdrarr(n, 1) Then
                          outarr(n, 1) = inarr(m, 1)
                          outarr(n, 2) = inarr(m, 2)
                          Exit For
                        End If
    Next m
Next n
Range(.Cells(1, 4), .Cells(lrR, 5)) = outarr


End With
End Sub

 

[Fluff]

How about

Sub MatchData()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim i As Long
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Pcode")
   Ary1 = Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp)).Resize(, 5).value2
   Ary2 = Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).value2
   With CreateObject("scripting.dictionary")
      For i = 3 To UBound(Ary2)
         .Item(Ary2(i, 1)) = Array(Ary2(i, 1), Ary2(i, 2))
      Next i
      For i = 3 To UBound(Ary1)
         Ary1(i, 4) = .Item(Ary2(i, 1))(0)
         Ary1(i, 5) = .Item(Ary1(i, 1))(1)
      Next i
   End With
   Ws1.Range("A2").Resize(UBound(Ary1), 5).Value = Ary1
End Sub

 

[offthelip]

@Fluff,
I notice on more than one occasion you have solved a problem using scripting dictionaries where I have posted a solution using variant arrays. Have you ever done any tests to compare the performance of these two methods? And if so are they conditions where one method is faster than the other?

 

[borntobe]

Thanks! offthelip. I tried your method first.
It took 2 minutes.

 

[borntobe]

Fluff,
I got an error on the line;

 Ary1(i, 5) = .Item(Ary1(i, 1))(1)  '<<<=== type mismatch error

Both colum A are Text type.
How can I solve this error?
Thanks.

 

[Fluff]

Couple of typos in there, try

Sub MatchData()
   Dim ary1 As Variant, ary2 As Variant
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim i As Long
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("sheet2")
   ary1 = Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp)).Resize(, 5).value2
   ary2 = Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).value2
   ary1(1, 4) = "Item from Sheet2"
   ary1(1, 5) = "Rate from sheet2"
   With CreateObject("scripting.dictionary")
      For i = 2 To UBound(ary2)
         .Item(ary2(i, 1)) = Array(ary2(i, 1), ary2(i, 2))
      Next i
      For i = 2 To UBound(ary1)
         If .exists(ary1(i, 1)) Then
            ary1(i, 4) = .Item(ary1(i, 1))(0)
            ary1(i, 5) = .Item(ary1(i, 1))(1)
         End If
      Next i
   End With
   Ws1.Range("A2").Resize(UBound(ary1), 5).Value = ary1
End Sub

 

[Fluff]

@offthelip
I'm not a massive fan of speed tests, so don't often do them.
But in this instance, with ~7700 rows of data on both sheets, your code takes about 9.6 seconds, whereas mine is 0.1 seconds.
Dictionaries are very quick & powerful & I would recommend learning them. a good site for that is https://excelmacromastery.com/vba-dictionary/
Because the OP said that the data was 80,000 rows I used an array with the dictionary, but my normal method is

Sub MatchData2()
   Dim cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim i As Long
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Pcode")
   With CreateObject("scripting.dictionary")
      For Each cl In Ws2.Range("A3", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(cl.Value) = cl.Resize(, 2)
      Next cl
      For Each cl In Ws1.Range("a3", Ws1.Range("A" & Rows.Count).End(xlUp))
         cl.Offset(, 3).Resize(, 2).Value = .Item(cl.Value)
      Next cl
   End With
End Sub

which on my test data is still only 0.5seconds despite looping through the cells.

 

[Fluff]

FWIW I created a test sheet with 100,000 rows of data in sheet1 & 10,942 rows in sheet2 & the results were (time in seconds)

post#2	338.6
post#7	0.8
post#8	15.2

<tbody>
</tbody>

 

[offthelip]

Thanks masses Fluff, I am often looking for faster ways of doing things because I often seem to have massive data files. So I will definitely try scripting dictionaries a bit more. I have used them but only for "Dictionaries" Which I don't need very often