Rip1971
Board Regular
- Joined
- Nov 3, 2020
- Messages
- 65
- Office Version
- 365
- Platform
- 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.
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