lookup and compare/copy between 2 workbooks

Rip1971

Board Regular
Joined
Nov 3, 2020
Messages
50
Office Version
  1. 365
Platform
  1. Windows
Hi there,

I have code to lookup an ID in one sourceworkbook compare that with an ID in destination workbook and then copy a cell value from source to destination.
However when i have a large file/list (5000+ rows in source and 250000+ row in destination) this looping of looking for and copying takes very long.
Who can give me same results but in a faster manner.


VBA Code:
Sub CopyPloegPU(control As IRibbonControl)
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, ID As Range, fnd As Range, sAddr As String
    Set srcWS = Workbooks("Adressenlijst_PU_ID10331.xlsx").Sheets("Adressenlijst")
    Set desWS = ActiveWorkbook.Sheets("Data")
    With srcWS
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each ID In .Range("A2:A" & LastRow)
            Set fnd = desWS.Range("A:A").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                sAddr = fnd.Address
                Do
                    desWS.Range("T" & fnd.Row) = ID.Offset(, 1)
                    Set fnd = desWS.Range("A:A").FindNext(fnd)
                Loop While fnd.Address <> sAddr
            End If
            sAddr = ""
    
    Next ID
    End With
    Application.ScreenUpdating = True
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,809
Office Version
  1. 365
Platform
  1. Windows
Ok, you would need to make these changes
Rich (BB code):
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         .Item(Ary(r, 2)) = Ary(r, 1)
      Next r
      LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Ary = desWS.Range("F2:F" & LastRow).Value2
      Nary = desWS.Range("K2:K" & LastRow).Value2
      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))
      Next r
   End With
   desWS.Range("K2").Resize(UBound(Nary)).Value = Nary
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Rip1971

Board Regular
Joined
Nov 3, 2020
Messages
50
Office Version
  1. 365
Platform
  1. Windows
Ok, you would need to make these changes
Rich (BB code):
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         .Item(Ary(r, 2)) = Ary(r, 1)
      Next r
      LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Ary = desWS.Range("F2:F" & LastRow).Value2
      Nary = desWS.Range("K2:K" & LastRow).Value2
      For r = 1 To UBound(Ary)
         If .Exists(Ary(r, 1)) Then Nary(r, 1) = .Item(Ary(r, 1))
      Next r
   End With
   desWS.Range("K2").Resize(UBound(Nary)).Value = Nary
Oke, i figured it out now what part does the same as what i did with offset. i tried it on several occasions with different file layout so i know what i can adjust to get the right result.
Thank you for your help in this matter

Rip
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,809
Office Version
  1. 365
Platform
  1. Windows
My pleasure.
 

Watch MrExcel Video

Forum statistics

Threads
1,128,172
Messages
5,629,126
Members
416,365
Latest member
dof

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top