Retrieval of information from a workbook using unique ID - vba

Question

I have two workbooks , one is a active list(database) and the other is a project tracker(dashboard).
Both workbooks have a project ID.
I want that the workbook and active list should have a loop to match the exact project IDs.
If the project ID is found in the active list, it would retrieve information from that row and overwrite the existing row in the project tracker,which contains that project ID.
This is an example of the code which i have done, I did something relevant but it does not seem to work :
Sub AAA()
'If Workbooks("Source.xlsm").Sheets("Sheet2").Range("A2").Value = Workbooks("Target.xlsm").Sheets("Sheet1").Range("A2").Value Then
'Workbooks("Source.xlsm").Sheets("Sheet2").Range("B2").Value = Workbooks("Target.xlsm").Sheets("Sheet1").Range("C2").Value
Dim a As Long
Dim lastrow As Long
Dim lastcol As Long
Dim source As Worksheet
Dim target As Worksheet
Set target = Workbooks("Target.xlsm").Sheets("Sheet1")
Set source = Workbooks("Source.xlsm").Sheets("Sheet2")
lastrow = source.Range("A" & target.Rows.Count).End(xlUp).Row
lastcol = target.Cells(2, target.Columns.Count).Column
target.Activate
For a = 2 To 50
If source.Range("A" & a).Value = target.Range("A" & a).Value Then
target.Range("C" & a).Select
Range(ActiveCell, ActiveCell.Offset(0)).Copy
source.Range("B" & a).PasteSpecial
End If
Next a
End Sub

Answer 1

You are misunderstanding how you use the Range object. This .Range("A").Value does not work, you need to include a row number as well, such as .Range("A1").Value.
Your logic assumes that both lists are in exactly the same order. Using the Range.Find method gets round that problem.
Sub AAA()
Dim source As Worksheet
Dim target As Worksheet
Dim cell As Range
Dim cellFound As Range
Set target = Workbooks("Target.xlsm").Sheets("Sheet1")
Set source = Workbooks("Source.xlsm").Sheets("Sheet2")
For Each cell In target.Range("A2:A50")
' Try to find this value in the source sheet
Set cellFound = source.Range("A:A").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellFound Is Nothing Then
' A matching value was found
' So copy the cell 2 columns across to the cell adjacent to matching value
' Do a "normal" copy & paste
cell.Offset(ColumnOffset:=2).Copy cellFound.Offset(ColumnOffset:=1)
' Or do a copy & paste special values
'cell.Offset(ColumnOffset:=2).Copy
'cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues
Else
' The value in this cell does not exist in the source
' Should anything be done?
End If
Next
End Sub
Are you aware that you are using different sheets for source and for target?

Answer 2

target.Activate
For a = 2 To 50
If source.Range("A" & a).Value = target.Range("A" & a).Value Then
target.Range("C" & a).EntireRow.Select
Selection.Copy
source.Range("B" & a).PasteSpecial
End If
Next a

Answer 3

Not sure what volume of data you're going to be working with, but you could also use arrays to achieve what you're after.
Option Explicit
Sub AAA()
Dim i As Long, j As Long, k As Integer
Dim source As Worksheet, target As Worksheet
Dim arrTarget() As Variant, arrSource() As Variant
Dim lrowSrc As Long, lcolSrc As Long, lrowTrgt As Long, lcolTrgt As Long
Set target = Workbooks("Book4.xlsb").Sheets("Sheet1")
Set source = Workbooks("Book3.xlsb").Sheets("Sheet1")
lrowSrc = source.Cells(target.Rows.Count, 1).End(xlUp).Row
lcolSrc = source.Cells(2, source.Columns.Count).End(xlToLeft).Column
lrowTrgt = target.Cells(target.Rows.Count, 1).End(xlUp).Row
lcolTrgt = target.Cells(2, target.Columns.Count).End(xlToLeft).Column
target.Activate
arrTarget = target.Range(Cells(2, 1), Cells(lrowTrgt, lcolSrc))
source.Activate
arrSource = source.Range(Cells(2, 1), Cells(lrowSrc, lcolSrc))
target.Activate
For i = LBound(arrTarget, 1) To UBound(arrTarget, 1)
For j = LBound(arrSource, 1) To UBound(arrSource, 1)
If arrTarget(i, 1) = arrSource(j, 1) Then
For k = LBound(arrSource, 2) To UBound(arrSource, 2)
arrTarget(i, k) = arrSource(j, k)
Next k
Exit For
End If
Next j
Next i
target.Range("A2").Resize(UBound(arrTarget, 1), UBound(arrTarget, 2)).Value = arrTarget
End Sub
Working on 12,000 rows of data in the Target workbook and 25,000 in the Source workbook, with 6,000 matches, the code took 9.91 seconds to run.