change iteration for two loops For Next

[mokie]

Hello, Probably my brain is burning and that's thing could so easy but I need some help from experts.

With my example, I've got 2 sheet.
I have some requirements to find in WorkSheet(DataBase)
(text in column 4, and date in column 11)
In column 2 - I have unique numer for rows.
after match I'd like to copy after ReDim Preserve array arr() to WorkSheet(OutSheet) on first blank rows.

In this issue I've got one problem
1.Before paste data form (DataBase) I need check "OutSheet" and paste only new records not exist in Worksheet(OutSheet).

When loop starts for "i_2" going faster then "i" and condition "j=j+1" create 3 rows. Ok maybe somebody could align that case..

Thanks in advance.

Sub SearchReq()
    Dim tb, arr(), tb_2
    Dim i As Long, j As Long, k As Integer, kol As Integer
    Dim i_2 As Long
    Dim req1 As Variant, req2 As Variant, req3DateLowL As Variant, req4DateUppL As Variant
 
    With ThisWorkbook.Sheets("DataBase")
      req1 = .[A2]
      req2 = .[B2]
   
      req3DateLowL = .[E2]
      req4DateUppL = .[F2]
 
    With ThisWorkbook.Sheets("OutSheet")
        tb_2 = .Range("B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
    End With
   
 

    With ThisWorkbook.Sheets("DataBase")
        tb = .Range("A5:O" & .Cells(.Rows.Count, 2).End(xlUp).Row)
     
     
    kol = UBound(tb, 2)

 
    For i_2 = 1 To UBound(tb_2)
    For i = 1 To UBound(tb)
 
    If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) And (tb(i, 2) <> tb_2(i_2, 1)) And (tb(i, 4) = req2) Or (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL And (tb(i, 2) <> tb_2(i_2, 1)) Then
   
        j = j + 1
        'j=1
        'If i_2 >= UBound(tb_2) - 1 Then j = j + 1
     
     
        ReDim Preserve arr(1 To kol, 1 To j)
          For k = 1 To kol
          arr(k, j) = tb(i, k)
          Next
          End If
 
    Next i
    Next i_2
  ' End With
           
              With ThisWorkbook.Sheets("OutSheet").Select
                Sheets("OutSheet").Range("A1").End(xlDown).Offset(1, 0).Select
                ActiveCell.Resize(UBound(arr, 2), kol) = Application.Transpose(arr)
              End With
              End With
          End With
       
         
End Sub