Source
Target
i have two column in source with 200 rows. In target sheet, have 300 rows. Need to create a lookup from Target to Source to get 2nd column value from Source sheet. I don't want to use VLOOKUP. Currently i am doing thru loop :
For i =1 to lastrow of Target tab
for j=1 to lastrow of source tab
if target.cells(i,1) = source.cells(j,1) then
target.cells(i,2)= source.cells(j,2)
exit for
end if
next j
next i
This code take too much time as i have 200 columns in source to copy and paste to target tab. Just need any optimization code for the same. Also target tab have more rows compared to source tab data.
Sub LookupData()
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Sheets("Source")
Dim slrg As Range: ' lookup
Set slrg = sws.Range("A2", sws.Cells(sws.Rows.Count, "A").End(xlUp))
Dim srrg As Range: Set srrg = slrg.EntireRow.Columns("B") ' return
' Target
Dim tws As Worksheet: Set tws = wb.Sheets("Target")
Dim tlrg As Range: ' lookup
Set tlrg = tws.Range("A2", tws.Cells(tws.Rows.Count, "A").End(xlUp))
Dim trrg As Range: Set trrg = tlrg.EntireRow.Columns("B") ' return
' Lookup
With Application
trrg.Value = .IfNa(.Index(srrg, .Match(tlrg, slrg, 0)), "")
' in MS365
'trrg.Value = .XLookup(tlrg, slrg, srrg, "")
End With
' Inform.
MsgBox "Data looked up.", vbInformation
End Sub
A Test
Sub LookupDataSlow()
' Workbook.
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Sheets("Source")
Dim sLastRow As Long: ' lookup
sLastRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
' Target
Dim tws As Worksheet: Set tws = wb.Sheets("Target")
Dim tLastRow As Long: ' lookup
tLastRow = tws.Cells(tws.Rows.Count, "A").End(xlUp).Row
Dim sRow As Long, tRow As Long
Dim ReadCount As Long, WriteCount As Long
For tRow = 2 To tLastRow
For sRow = 2 To sLastRow
ReadCount = ReadCount + 2
If sws.Cells(sRow, "A").Value = tws.Cells(tRow, "A").Value Then
ReadCount = ReadCount + 1
WriteCount = WriteCount + 1
tws.Cells(tRow, "B").Value = sws.Cells(sRow, "B").Value
Exit For
End If
Next sRow
Next tRow
' Inform.
MsgBox "Slow Data Lookup" & vbLf & vbLf _
& "ReadCount: " & ReadCount & vbLf _
& "WriteCount: " & WriteCount & vbLf _
& "TotalCount: " & ReadCount + WriteCount, vbInformation
End Sub
Exit For
, the sheet was accessed 82 times while without it even 116 times. Let us know how many times it was accessed when it ran on your data set.