Excel VBA - Check if row values in 2 columns match, then return specific value in corresponding row of another column

[TropicalMagic]

Hi all,



I would like to check if row values in the Column A, "Origin" and Column B, "Destination", both of which in Workbook 1's Sheet 1, can be found in Column C "Country List" of Workbook 2's Sheet 1



If yes, then return "Y" in the corresponding rows in Column J, "Origin Found" and Column K, "Destination Found" respectively, both of which are also in Workbook 1's Sheet 1.



If no, then do nothing.



However, my code is not working.



Here is my non-functional code so far:

(Note that I have split them into 2 parts, Origin & Origin Found vs Destination & Destination Found, if you can somehow make them run as 1, it would be good too)



```

Dim wsk1, wsk2 As Worksheet

Dim x1, x2, LastRow As Long

Dim arrA, arrB As Variant

Dim arrJ, arrK As Variant

Dim answer As Range



Set wsk1 = Workbooks("ORIGINS & DESTINATIONS.xlsx").Sheets(1)

Set wsk2 = Workbooks("COUNTRY LIST.xlsx").Sheets(1)

LastRow = wsk1.Range("A" & Rows.Count).End(xlUp).Row



' Origin & Origin Found



arrA = wsk1.Range("A2:A" & LastRow).Value



ReDim arrJ(1 To UBound(arrA), 1 To 1)



For x1 = 1 To UBound(arrA)

answer = wsk1.Range("C" & j).Value

If arrA(x1, 1) = answer1 Then

arrJ(x1, 1) = "Y"

End If

Next x1



wsk1.Range("J2").Resize(UBound(arrJ), 1).Value = arrJ




' Destination & Destination Found



arrB = wsk1.Range("B2:B" & LastRow).Value



ReDim arrK(1 To UBound(arrB), 1 To 1)



For x2 = 1 To UBound(arrB)

answer = wsk1.Range("C" & j).Value

If arrB(x2, 1) = answer1 Then

arrK(x2, 1) = "Y"

End If

Next x2



wsk1.Range("K2").Resize(UBound(arrK), 1).Value = arrK

```

 

[mumps]

Place this macro in Workbook1. Make sure that both workbooks are open before running the macro. Change the workbook 2 name (in red) to suit your needs.

Sub MatchCountries()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, i As Long, v1 As Variant, v2 As Variant
    Set srcWS = Workbooks("Workbook2.xlsx").Sheets("Sheet1")
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    v2 = srcWS.Range("C2", srcWS.Range("C" & Rows.Count).End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v2, 1)
            If Not .Exists(v2(i, 1)) Then
                .Add v2(i, 1), Nothing
            End If
        Next i
        For i = 1 To UBound(v1, 1)
            If .Exists(v1(i, 1)) Then
                desWS.Range("J" & i + 1) = "Y"
            End If
            If .Exists(v1(i, 2)) Then
                desWS.Range("K" & i + 1) = "Y"
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[TropicalMagic]

Place this macro in Workbook1. Make sure that both workbooks are open before running the macro. Change the workbook 2 name (in red) to suit your needs.

Sub MatchCountries()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, i As Long, v1 As Variant, v2 As Variant
    Set srcWS = Workbooks("Workbook2.xlsx").Sheets("Sheet1")
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    v2 = srcWS.Range("C2", srcWS.Range("C" & Rows.Count).End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v2, 1)
            If Not .Exists(v2(i, 1)) Then
                .Add v2(i, 1), Nothing
            End If
        Next i
        For i = 1 To UBound(v1, 1)
            If .Exists(v1(i, 1)) Then
                desWS.Range("J" & i + 1) = "Y"
            End If
            If .Exists(v1(i, 2)) Then
                desWS.Range("K" & i + 1) = "Y"
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Many thanks! It worked as I intended and described!

 

[mumps]

You are very welcome.