Updating access records
Here is the code refined using these features:


rst.Filter
rst.Update
Scripting.Dictionary
Range("A1").CopyFromRecordset rst




Sub ThisBeTheShitMane()
    Const DBPath = "C:\Users\dzcoats\Documents\Microsoft.accdb"
    Const DebugMode As Boolean = False

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim key As String
    Dim vAr
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary")

    Set db = DBEngine.OpenDatabase(DBPath)
    Set rst = db.OpenRecordSet("SELECT [VDefects].Defect, [VDefects].Status FROM [VDefects] WHERE [VDefects].Defect IS NOT NULL;")

    'Combined List
    With Worksheets(1)
        For Each vAr In .Range("B2", .Range("B" &amp; .Rows.Count).End(xlUp)).Value
            key = vAr
            d(key) = "Completed"
        Next
    End With

    'Open List
    With Worksheets(1)
        For Each vAr In .Range("A2", .Range("A" &amp; .Rows.Count).End(xlUp)).Value
            key = vAr
            If d.Exists(key) Then
                d(key) = "OPEN"
            Else
                If DebugMode Then Debug.Print "vAr: "; vAr, "ID is in the Open List but is missing from the Combined List "
            End If
        Next
    End With

    With rst
        .MoveFirst
        Do Until .EOF
            key = ![Defect]
            .Edit
            ![Status] = IIf(d.Exists(key), d(key), "Bad Defect Number")
            .Update
            .MoveNext
        Loop
        .MoveFirst
    End With

    Worksheets("Sheet2").Range("A1").CopyFromRecordset rst

    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing

End Sub


But we could just let the database do the work for us by converting the Open and Combined list into a comma separated values list and using IN() to check the values.  If [Defect] is a text field you will has to wrap the values in quotes.

Sample Query:

UPDATE VDefects SET VDefects.Status = IIf([VDefects]![Defect] NOT IN (1,2,3,4,5,6) And [VDefects]![Defect] NOT IN (4,5,6,7,8,9),'Bad Defect Number',IIf([VDefects]![Defect] NOT IN (1,2,3,4,5,6),'Completed','OPEN'));




Sub JustDoIt()
    Const DBPath = "C:\Users\best buy\Desktop\Microsoft.accdb"
    Dim db As DAO.Database: Set db = DBEngine.OpenDatabase(DBPath, , True)
    Dim rst As DAO.Recordset
    Dim sSQL As String, t1 As String, t2 As String
    Dim arr1 As Variant, arr2 As Variant

    With Sheet1
        t1 = getValueList(.Range("A2", .Range("A" &amp; rows.Count).End(xlUp)), False)
        t2 = getValueList(.Range("B2", .Range("B" &amp; rows.Count).End(xlUp)), False)
    End With

    sSQL = "UPDATE VDefects SET VDefects.Status = IIf([VDefects]![Defect] NOT IN (" &amp; t1 &amp; ") And [VDefects]![Defect] NOT IN (" &amp; t2 &amp; "),'Bad Defect Number',IIf([VDefects]![Defect] NOT IN (" &amp; t1 &amp; "),'Completed','OPEN'));"

    db.Execute sSQL

    Set rst = db.OpenRecordSet("SELECT [VDefects].Defect, [VDefects].Status FROM [VDefects] WHERE [VDefects].Defect IS NOT NULL;")
    Worksheets("Sheet2").Range("A1").CopyFromRecordset rst

    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing
End Sub

Function getValueList(Target As Range, WrapInQuotes) As String
    Dim arr As Variant
    arr = Application.TRanspose(Target.Value)

    If WrapInQuotes Then
        getValueList = Join(arr, """,""") &amp; """"
    Else
        getValueList = Join(arr, ",")
    End If
End Function