Speed up Macro

Hi Folks,

Still fairly new to VBA, I am currently using the below code to compare Column A between Sheet1 and Sheet2 then bring in the value of Column B in Sheet2 into Column B of Sheet1.

This is great when working with low row numbers, however, I'm now working on a file with 10000+ rows and the macro is taking very long to process.

Current code;

Code:

---

Option Explicit
Sub GetValues()
Application.ScreenUpdating = False


Dim i As Long, j As Long
        Sheet1LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        Sheet2LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
       
        For j = 1 To Sheet1LastRow
        For i = 1 To Sheet2LastRow
       
            If Worksheets("Sheet1").Cells(j, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value Then
            Worksheets("Sheet1").Cells(j, 2).Value = wb.Worksheets("Sheet1").Cells(i, 2).Value
            End If
        Next i
        Next j


End Sub

---

Would anyone have a more efficient way of doing this to speed up the processing time?

Many Thanks

Fra

…but it's not your current code, is it? No mention of Sheet2 at all!
Try:

Code:

---

Sub GetValues2()
Sheet1LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Sheet1").Range("B1:B" & Sheet1LastRow)
  .FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!R1C1:R" & Sheet2LastRow & "C2,2,FALSE)"
  .SpecialCells(xlCellTypeFormulas, 16).ClearContents
  .Value = .Value
End With
End Sub

---

If it's still too slow then we can try again.
Perhaps:

Code:

---

Sub GetValues3()
Set rng1 = Range(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Set rng2 = Range(Worksheets("Sheet2").Range("A1"), Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
cc = Application.VLookup(rng1, rng2, 2, False)
For i = 1 To UBound(cc)
  If IsError(cc(i, 1)) Then cc(i, 1) = Empty
Next i
rng1.Offset(, 1).Value = cc
End Sub

---

Another option

Code:

---

Sub LookupCopy()
  Dim InAry As Variant, Oary As Variant
  Dim i As Long
 
  With Sheets("sheet1")
      InAry = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 1))
  End With
  With Sheets("sheet2")
      Oary = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 1))
  End With
  With CreateObject("scripting.dictionary")
      For i = 1 To UBound(InAry)
        .Item(InAry(i, 1)) = InAry(i, 2)
      Next i
      For i = 1 To UBound(Oary)
        Oary(i, 2) = .Item(Oary(i, 1))
      Next i
  End With
  Sheets("sheet2").Range("B1").Resize(UBound(Oary)).Value = Application.Index(Oary, 0, 2)
End Sub

---

Try this

Looping is slow, nested loops are really slow, and if the loops access worksheets repeatedly, it's REALLY slow

Code:

---

Option Explicit


Sub TEST()
    Dim r1 As Range, r2 As Range
    Dim ary12 As Variant, ary22 As Variant, ary1 As Variant, ary2 As Variant
    Dim i As Long, m As Long
   
    Set r1 = Worksheets("sheet1").Cells(1, 1).CurrentRegion.Resize(, 2)
    Set r2 = Worksheets("sheet2").Cells(1, 1).CurrentRegion
   
    ary12 = r1.Value
    ary22 = r2.Value
   
    ary1 = Application.WorksheetFunction.Transpose(r1.Columns(1))
    ary2 = Application.WorksheetFunction.Transpose(r2.Columns(1))
   
   
    For i = LBound(ary1) To UBound(ary1)
        m = 0
        On Error Resume Next
        m = Application.WorksheetFunction.Match(ary1(i), ary2, 0)
        On Error Resume Next
       
        If m > 0 Then
            ary12(i, 2) = ary22(m, 2)
        End If
    Next i
   
    r1.Value = ary12
End Sub

---

Many Thanks for the replies, both methods have certainly speeded things up!

p45cal one more question, just say I wanted to get the values of column D from Sheet2 into Column D of Sheet1 by comparing Column A how would I modify below code to make it work?

Code:

---

---

Code:

---

Sub GetValues3()Set rng1 = Range(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Set rng2 = Range(Worksheets("Sheet2").Range("A1"), Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
cc = Application.VLookup(rng1, rng2, 2, False)
For i = 1 To UBound(cc)
  If IsError(cc(i, 1)) Then cc(i, 1) = Empty
Next i
rng1.Offset(, 1).Value = cc
End Sub

---

Thanks Again

Fra

Quote:

---

Originally Posted by framcc06

just say I wanted to get the values of column D from Sheet2 into Column D of Sheet1 by comparing Column A how would I modify below code to make it work?

---

untested:

Code:

---

Sub GetValues3()
Set rng1 = Range(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
Set rng2 = Range(Worksheets("Sheet2").Range("A1"), Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Resize(, 4)
cc = Application.VLookup(rng1, rng2, 4, False)
For i = 1 To UBound(cc)
  If IsError(cc(i, 1)) Then cc(i, 1) = Empty
Next i
rng1.Offset(, 3).Value = cc
End Sub

---

Thanks p45cal, it worked perfectly.

I'm marking this thread as solved.

Thanks again

Fra

Since this thread's subject is "Speed up Macro", what kind of speed increase did you obtain?
Did you compare others' solutions for speed?

Sorry, the code I used from the first post was around 40 minutes, your generous solution done it in a matter of seconds.

Fra

Speed test results on 10,000 unique, randomly sorted values on sheet1 and 2000 unique randomly sorted rows of lookup table on sheet2. The GetValues sub took 230 seconds on my machine.
GetValues 1
TEST 50
GetValues2 400
GetValues3 412
LookupCopy 5230

So Fluff's LookupCopy is streaks ahead (13 times quicker than my faster offering) although it needed tweaking to match the lookup table being on sheet2 and the results being placed on Sheet1:

Code:

---

Sub LookupCopy()
Dim InAry As Variant, Oary As Variant
Dim i As Long
 
With Sheets("sheet1")
  Oary = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 1))
End With
With Sheets("sheet2")
  InAry = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 1))
End With
Set dic = CreateObject("scripting.dictionary")
With dic
  For i = 1 To UBound(InAry)
    .Item(InAry(i, 1)) = InAry(i, 2)
  Next i
  For i = 1 To UBound(Oary)
    Oary(i, 2) = .Item(Oary(i, 1))
  Next i
End With
Sheets("sheet1").Range("B1").Resize(UBound(Oary)).Value = Application.Index(Oary, 0, 2)
End Sub

---

@p45cal --

I'm curious -- I like to use the Match technique in my #4 for lots of different things (but I'm willing to learn others)

Could you use that macro with your test data and let me know the relative performance?

Thanks

p45cal last question on your GetValues3 code.

If i wanted to get the values from Column A from Sheet2 into Column D of Sheet1 by comparing values of Column B of Sheet1 and Sheet2 would I need to use offset somewhere in the rng2 worksheet name?

Thanks

Fra

Quote:

---

Originally Posted by Paul_Hossler

Could you use that macro with your test data and let me know the relative performance?

---

It's there in msg#10, under TEST. (50 times faster than GetValues which has a performance of 1. All the macros are rated using GetValues as a base, so LookupCopy is 5230 times faster than GetValues.)
Attachment 22961
(The GetValues No Exit For is the OP's original macro, the GetValues Exit For is a version of it where I added an Exit For line within the inner loop to stop searching if a match was found)

Quote:

---

Originally Posted by framcc06

If i wanted to get the values from Column A from Sheet2 into Column D of Sheet1 by comparing values of Column B of Sheet1 and Sheet2 would I need to use offset somewhere in the rng2 worksheet name?

---

I'm confused. Sheet1 doesn't have any values in column B until after one of the macros is run. So could you supply a workbook to clarify what you're wanting?

Quote:

---

Originally Posted by p45cal

It's there in msg#10, under TEST. (50 times faster than GetValues which has a performance of 1. All the macros are rated using GetValues as a base, so LookupCopy is 5230 times faster than GetValues.)

---

Sorry - I missed that

I'm amazed that using a Dictionary is ~100x faster than using arrays and built-in functions (e.g. TEST)

I'd have thought that building the dictionary and looking up indexes would have added more overhead

p45cal sorry for the confusion, I have attached 2 sample files test1 & test2.

test1 has Fluff's LookupCopy code (thanks Fluff btw), now, how would I modify it on the test2 file where I want to compare Column B in both sheets, then import the values from Column A in sheet 1 into Column D of sheet2.

Thanks Again

Fra

There are no values in col A on sheet1 & even if there were the sheet1 col A heading is different to the sheet2 col D heading

Quote:

---

Originally Posted by Paul_Hossler

I'm amazed that using a Dictionary is ~100x faster than using arrays and built-in functions (e.g. TEST)
I'd have thought that building the dictionary and looking up indexes would have added more overhead

---

See if I've done anything wrong in the attached.
Stuff gets put in the Immediate pane of the VBE which can be copy/pasted to a sheet and a pivot table created.

framcc06, I won't be able to do anything until tomorrow afternoon (UK time).

Oops! I got the sheets mixed up should be... compare Column B in both sheets, then import the values from Column A in sheet2 into Column D of sheet1. I also didn't think the heading names would matter.

Fra

Try

Code:

---

Sub LookupCopy()
  Dim InAry As Variant, Oary As Variant
  Dim i As Long
 
  With Sheets("sheet2")
      InAry = .Range("A2", .Range("B" & Rows.Count).End(xlUp))
  End With
  With Sheets("sheet1")
      Oary = .Range("B2", .Range("B" & Rows.Count).End(xlUp).Offset(, 2))
  End With
  With CreateObject("scripting.dictionary")
      For i = 1 To UBound(InAry)
        .Item(InAry(i, 2)) = InAry(i, 1)
      Next i
      For i = 1 To UBound(Oary)
        Oary(i, 3) = .Item(Oary(i, 1))
      Next i
  End With
  Sheets("sheet1").Range("d2").Resize(UBound(Oary)).Value = Application.Index(Oary, 0, 3)
End Sub

---

Quote:

---

Originally Posted by framcc06

how would I modify it on the test2 file where I want to compare Column B in both sheets, then import the values from Column A in sheet 1 into Column D of sheet2.

---

VLookUp is designed to look up a vaue in the leftmost column of a range and return the value in one of the columns to the right of it. In this case it's easier to use Index/Match (Vlookup can be used to lookup to the left but it's convoluted to do so and I've never made it work in vba, only on a sheet). This code is designed to work on your Test2.xlsm file:

Code:

---

Sub GetValues5()
Set rng1 = Range(Worksheets("Sheet1").Range("B2"), Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp))
Set rng2a = Range(Worksheets("Sheet2").Range("B2"), Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp))
Set rng2b = rng2a.Offset(, -1)
'---------------------------
'either:
cc = Application.Index(rng2b, Application.Match(rng1, rng2a, 0))

'or (if you've got more than 1 column to process you can use the same index):
'dd = Application.Match(rng1, rng2a, 0)
'cc = Application.Index(rng2b, dd)
'---------------------------
For i = 1 To UBound(cc)
  If IsError(cc(i, 1)) Then cc(i, 1) = Empty
Next i
rng1.Offset(, 2).Value = cc
End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

I'd have thought that building the dictionary and looking up indexes would have added more overhead

---

Paul, I agree, one would expect that, but I've long since expected the unexpected with Excel and often test something like this to try to confirm the expected. [Actually, this isn't confined to Excel, but to life in general; so many times people (politicians included/especially) make a statement which they try and make out is blinking obvious, but when you dig deeper you find it's not so obvious, and is often downright wrong. People call me cynical, but I won't change as this sort of thing happens only too often]
Anyway, did you look at my testing file in msg#18 and get similar results?

I got similar times although I was getting times of ~7.8 for TEST.
But with this version I was getting ~6.4

Code:

---

Sub TEST()
Dim r1 As Range, r2 As Range
Dim ary12 As Variant, ary22 As Variant, ary1 As Variant, ary2 As Variant
Dim i As Long, m As Long
StartTime = Timer
   
Set r1 = Worksheets("sheet1").Cells(1, 1).CurrentRegion.Resize(, 2)
Set r2 = Worksheets("sheet2").Cells(1, 1).CurrentRegion
   
ary12 = r1.Value
ary22 = r2.Value
'
'ary1 = Application.WorksheetFunction.Transpose(r1.Columns(1))
'ary2 = Application.WorksheetFunction.Transpose(r2.Columns(1))
   
   
For i = LBound(ary12) To UBound(ary12)
  For j = LBound(ary22) To UBound(ary22)
      If ary12(i, 1) = ary22(j, 1) Then
        ary12(i, 2) = ary22(j, 2)
        Exit For
  End If
  Next j
Next i
Debug.Print "TEST" & vbTab & Timer - StartTime
    Sheet1.Range("B1").Resize(UBound(ary12)).Value = Application.Index(ary12, 0, 2)
'r1.Value = ary12 'commented out because I didn't want possibly to mess column A
End Sub

---

Nested loops through arrays seems faster than using Application.Match

Thanks p45cal, I did think I needed to use Offset somewhere but just didn't know where to stick it in the code.

Once again thanks to everyone who have helped with their suggestions.

Fra