VBA loop through and copy data to another table

[cknnugget]

Trying to create a macro to loop through Table 1.
If there is a date in the Table 1 ETA column.
Then Find the matching unique ID in Table 2 and copy the date into the Table 2 ETA column

The solution is probably simple everything I have tried has not come close though.

Table 1

Unique ID	ETA
1​	12/1/2022​
2​

Table 2

Unique ID	ETA	Arrival Date
1​		Filler
2​		Filler
3​		Filler

 

[cknnugget]

Finally figured it out. It is a little laggy but functional

Sub datetest()
Dim ETA As ListObject
Dim DB As ListObject
Set ETA = Sheets(Sheet2.Name).ListObjects("ETA")
Set DB = Sheets(Sheet2.Name).ListObjects("DB")

'Loops through ETA (Table1)to find rows with Date
For i = 1 To ETA.DataBodyRange.Rows.Count
If IsDate(ETA.DataBodyRange(i, 2)) Then

'Loops through DB (Table2) matches the unique ID
For i2 = 1 To DB.DataBodyRange.Rows.Count
If ETA.DataBodyRange(i, 1) = DB.DataBodyRange(i2, 1) And IsEmpty(DB.DataBodyRange(i2, 2)) Then

'copies data from ETA to DB
DB.DataBodyRange(i2, 2) = ETA.DataBodyRange(i, 2)
DB.DataBodyRange(i2, 4) = ETA.DataBodyRange(i, 4)
Else

End If

Next
End If
Next

End Sub

 

[Alex Blakenburg]

This should have very little "lag" if you want to give it a try:

Sub DateTestDict()
    Dim tblETA As ListObject
    Dim tblDB As ListObject
    Dim arrETA As Variant
    Dim arrDB As Variant
    Dim i As Long, i2 As Long
    Dim dictETA As Object, dictKey As String
    
    Set tblETA = Range("ETA").ListObject
    Set tblDB = Range("DB").ListObject
    
    arrETA = tblETA.DataBodyRange.Value2
    arrDB = tblDB.DataBodyRange.Value2

    Set dictETA = CreateObject("Scripting.dictionary")
    
    ' Load details range into Dictionary - if ETA is not blank
    For i = 1 To UBound(arrETA)
        If arrETA(i, 2) <> "" Then
            dictKey = arrETA(i, 1)
            If Not dictETA.exists(dictKey) Then
                dictETA(dictKey) = i
            End If
            End If
    Next i
    
    ' Get values from using the dictionary where table DB column ETA is blank
    For i = 1 To UBound(arrDB)
        dictKey = arrDB(i, 1)
        If dictETA.exists(dictKey) Then
            If arrDB(i, 2) = "" Then
                'copies data from ETA to DB
                arrDB(i, 2) = arrETA(dictETA(dictKey), 2)
                arrDB(i, 4) = arrETA(dictETA(dictKey), 4)
            End If
        End If
    Next i
    
    ' Write back updated data
    tblDB.ListColumns(2).DataBodyRange = Application.Index(arrDB, 0, 2)
    tblDB.ListColumns(4).DataBodyRange = Application.Index(arrDB, 0, 4)

End Sub

 

[cknnugget]

The speed difference is huge!
I speed tested both Macros on transferring 100 dates.
My code: 17 seconds
Your code: 0.08 seconds
Thank you for the assistance.
Not sure how the code works. Still new to VBA. Looks like scripting.dictionary and ubound are on the list to learn.

 

[Alex Blakenburg]

Thanks for giving such specific feedback, it is always nice to know how it performed on the actual data.
When you are ready the terms to look for are Dictionary and Array. Ubound is just getting the upper index number of what you have put into an array, roughly the equivalent of Rows.Count for the number of rows in a range.