Speed up Macro

[framcc06]

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;

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

[p45cal]

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

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:

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

[Fluff]

Another option

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

[Paul_Hossler]

Try this

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

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

[framcc06]

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?

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

[p45cal]

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:

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

[framcc06]

Thanks p45cal, it worked perfectly.

I'm marking this thread as solved.

Thanks again

Fra

[p45cal]

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

[framcc06]

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

Fra

[p45cal]

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:

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

[Paul_Hossler]

@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

[framcc06]

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

[p45cal]

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.)
2018-10-01_170834.jpg
(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)

[p45cal]

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?

[Paul_Hossler]

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

[framcc06]

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

[Fluff]

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

[p45cal]

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).

[framcc06]

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

[Fluff]

Try

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