CODEWITHSUNDEEP
vba
Pierre Bonaparte
Pierre Bonaparte

Reputation: 633

VBA check if the values from one column are present in the other and if so, transfer associated data

The code I have (below) does the job to an extent. My question is, how do I get the data in col B, C and D, to match the transfer to Tab1.

At the moment, the code looks at the values in the column A in Tab0, then checks whether any of them are present in col A in Tab 1 and if some are not there, it adds them on the bottom.

enter image description here

My current code:

Sub MovenMatch()

Dim varfirst1 As Range, varsecond2 As Range
Dim n&, m&
Dim first1 As Range, second2 As Range
Dim rowCount1&, rowCount2&
Dim mFlag As Boolean

rowCount1 = Sheets("Tab0").Cells(Sheets("Tab0").Rows.Count, "A").End(xlUp).Row
rowCount2 = Sheets("Tab1").Cells(Sheets("Tab1").Rows.Count, "A").End(xlUp).Row

Set varfirst1 = Sheets("Tab0").Range("A2:A" & rowCount1)
Set varsecond2 = Sheets("Tab1").Range("A2:A" & rowCount2)
m = rowCount2 + 1

For Each first1 In varfirst1
    mFlag = False
    For Each second2 In varsecond2
        If CStr(first1) = CStr(second2) Then
            mFlag = True
            Exit For
        End If
    Next second2

    If mFlag = False Then
        Sheets("Tab1").Range("A" & m).Value = first1

'My assumption is that the fix should come around here, replacing "xyz":

    Sheets("Tab1").Range("B" & m).Value = "xyz"


    m = m + 1
End If

Next first1
End Sub

Upvotes: 2

Views: 115

Answers (1)

TinMan
TinMan

Reputation: 7759

Collections are ideal for matching unique identifiers. My code stores cells references along with the unique IDs to simplify the tasks.

Sub MovenMatch2()
    Dim cell As Range, dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Tab1")
        For Each cell In .Range("A2", .Range("A" & .Rows.count).End(xlUp))
            Set dict(cell.Value) = cell
        Next
    End With

    With ThisWorkbook.Worksheets("Tab0")
        For Each cell In .Range("A2", .Range("A" & .Rows.count).End(xlUp))
            If dict.Exists(cell.Value) Then
                dict(cell.Value).Resize(1, 4).Value = cell.Resize(1, 4).Value
            Else
                With ThisWorkbook.Worksheets("Tab1")
                    .Range("A" & .Rows.count).End(xlUp).Offset(1).Resize(1, 4).Value = cell.Resize(1, 4).Value
                End With
            End If
        Next
    End With

End Sub

Upvotes: 3

Related Questions