Check if all column values exists in another list

Question

The excel vba macro I have created goes through an entire column and searches each value in the column against another column found on another worksheet. I have a T/F column where I mark down "T" if it is found, "F" if it is not found. However, I feel like the way I am doing it might not be very efficient, as the macro takes about 30 minutes to go through 31,000 rows of values to be searched from another column with about 27,000 number of values.

For a simple illustration, I have included a few images which explains what the macro does.

Initially the T/F column will be empty. Only after executing the macro, would it be filled. I loop through each row in column A and try to find the value against the SearchCol in the next picture.

Here is the vba code I am currently using.

Sub CheckIfValuesExist()
    Dim ActiveWS As Worksheet, WS2 As Worksheet
    Dim ValueColLetter As String, SearchColLetter As String, TFColLetter As String
    Dim LastRow As Long, i As Long
    Dim target As Variant, rng As Range

    Set ActiveWS = ActiveWorkbook.Worksheets(1)
    Set WS2 = ActiveWorkbook.Worksheets(2)
    ValueColLetter = "A"
    SearchColLetter = "A"
    TFColLetter = "B"
    LastRow = ActiveWS.Cells.Find(What:="*", SearchOrder:=xlRows, _
               SearchDirection:=xlPrevious, _
               LookIn:=xlFormulas).Row

    For i = 2 To LastRow
        target = ActiveWS.Range(ValueColLetter & i).Value
        If target <> "" Then
            With WS2.Range(SearchColLetter & ":" & SearchColLetter) 'searches all of column A
                Set rng = .Find(What:=target, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not rng Is Nothing Then
                    ActiveWS.Range(TFColLetter & i).Value = "T" 'value found
                Else
                    ActiveWS.Range(TFColLetter & i).Value = "F" 'value not found
                End If
            End With
        End If
    Next i
End Sub

The macro works as intended, I just find it to be slow. Is there any better way to do the same thing but in a quicker manner?

Answer 1

Check Column Against Column

Array Match Range Version

Sub CheckIfValuesExist()

    Const cSheet1 As Variant = 1  ' Value Worksheet Name/Index
    Const cSheet2 As Variant = 2  ' Search Worksheet Name/Index
    Const cFirst As Long = 2      ' First Row
    Const cVal As Variant = "A"   ' Value Column
    Const cSrc As Variant = "A"   ' Search Column
    Const cTF As Variant = "B"    ' Target Column
    Const cT As String = "T"      ' Found String
    Const cF As String = "F"      ' Not Found String

    Dim RngS As Range     ' Search Range
    Dim vntV As Variant   ' Value Array
    Dim vntT As Variant   ' Target Array
    Dim LastV As Long     ' Value Last Column Number
    Dim LastS As Long     ' Search Last Column Number
    Dim i As Long         ' Value/Target Row Counter
    Dim dummy As Long     ' Match Dummy Variable

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    On Error GoTo ProcedureExit

    With ThisWorkbook.Worksheets(cSheet1)
        LastV = .Columns(.Cells(1, cVal).Column).Find("*", , -4123, , 2, 2).Row
        vntV = .Range(.Cells(cFirst, cVal), .Cells(LastV, cVal))
    End With

    With ThisWorkbook.Worksheets(cSheet2)
        LastS = .Columns(.Cells(1, cSrc).Column).Find("*", , -4123, , 2, 2).Row
        Set RngS = .Range(.Cells(cFirst, cSrc), .Cells(LastS, cSrc))
        ReDim vntT(1 To UBound(vntV), 1 To 1)
        For i = 1 To UBound(vntV)
            On Error Resume Next
            If vntV(i, 1) <> "" Then
                dummy = Application.Match(vntV(i, 1), RngS, 0)
                If Err Then
                    vntT(i, 1) = cF
                  Else
                    vntT(i, 1) = cT
                End If
            End If
            On Error GoTo 0
        Next
    End With

    On Error GoTo ProcedureExit

    With ThisWorkbook.Worksheets(cSheet1)
        .Range(.Cells(cFirst, cTF), .Cells(.Rows.Count, cTF)).ClearContents
        .Cells(cFirst, cTF).Resize(UBound(vntT)) = vntT
    End With

ProcedureExit:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

Answer 2

Why don't you use the MATCH formula?

If your values are in Col A and the search values are at the cells $F$5:$F$10 the formula is:

=MATCH(A2,$F$5:$F$10,0)

or if you insist on a T/F result:

=IF(ISERROR(MATCH(A2,$F$5:$F$10,0)),"T","F")

Of cause you can insert this formula also with a macro.

Answer 3

Let us assume that data included in Sheet 1.

Try:

    Option Explicit

    Sub VlookUp()

        Dim LastRowSV As Long, LastRowV As Long, Counts As Long
        Dim wsName As String
        Dim wsListSV As Range, cellSV As Range, wsListV As Range, cellV As Range

        With ThisWorkbook.Worksheets("Sheet1")

            'Find the last row of Search Values
            LastRowSV = .Cells(.Rows.Count, "D").End(xlUp).Row
            'Find the last row of Values
            LastRowV = .Cells(.Rows.Count, "A").End(xlUp).Row

            'Set the list with the Search Values
            Set wsListSV = .Range(Cells(2, 4), Cells(LastRowSV, 4))
            'Set the list with the Values
            Set wsListV = .Range(Cells(3, 1), Cells(LastRowV, 1))

            'Loop each value in Search Values
            For Each cellV In wsListV
                Counts = Application.WorksheetFunction.CountIf(wsListSV, cellV)
                If Counts <> 0 Then
                    cellV.Offset(0, 1).Value = "T"
                Else
                    cellV.Offset(0, 1).Value = "F"
                End If

            Next

        End With

    End Sub

Result: