Sub test()
Dim i&, a1, a2, b, ii&
On Error Resume Next
i = Application.Match("OPEN", [order[status]], 0)
If Err.Number <> 0 Then Exit Sub
a1 = [Order].Cells(i, 1).Value
a2 = [Order].Cells(i, 3).Value
b = [bom].Value
For i = LBound(b) To UBound(b)
 If b(i, 1) = a1 Then ii = ii + 1: b(ii, 1) = b(i, 2): b(ii, 2) = a2
Next
With [task]
.Cells(.Rows.Count + 1, 1).Resize(ii, 2) = b
End With
End Sub

Sub tt()
    Dim a, i&, d1 As Object, d2 As Object, r As Range
 
    Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
    Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1
 
    Set a = [Order]
    For i = 1 To a.Rows.Count
        If a.Rows(i).Cells(2) = "OPEN" Then d1.Item(a.Rows(i).Cells(1).Value) = a.Rows(i).Cells(3).Value: a.Rows(i).Cells(2) = "CLOSED"
    Next
 
    a = ActiveSheet.ListObjects("BOM").DataBodyRange.Value
    For i = 1 To UBound(a)
        If d1.exists(a(i, 1)) Then d2.Item(a(i, 2)) = d1.Item(a(i, 1))
    Next
 
 If d2.Count Then
    Set r = ActiveSheet.ListObjects("task").DataBodyRange
    r.Cells(1).Offset(r.Rows.Count).Resize(d2.Count, 2) = Application.Transpose(Array(d2.keys, d2.items))
 End If
 
End Sub