Set wbReport = Workbooks.Open(strFileName)
    With wbReport.Worksheets("Sheet1")
        Set rngReport = .Range(.Cells(2, 6), .Cells(.Rows.Count, 2).End(xlUp))
    End With
     
    arrInput = rngReport.Value
     
    ReDim Preserve arr(4)
    For Each i In arrInput
        Set c = rngSummary.Find(What:=i, LookIn:=xlValues)
        If c(1, 1) Is Nothing Then
                  If с(1, 4) = "BRV" Then
                      arr(UBound(arr)) = i
                      ReDim Preserve arr(UBound(arr) + 1)
                 End If
        End If
    Next i
    ReDim Preserve arr(UBound(arr) - 1)
    wbReport.Close False
     
    With rngSummary
        .Cells(.Rows.Count + 1, 1).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
    End With

Sub Test()
Dim n As Integer, k As Integer, m As Integer
Dim lLastRow As Long

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row    
m = 1

For k = lLastRow To 1
    If Cells(k, 1).Value = Cells((k - 1), 1).Value Then
        Cells(k, 1).Value = CStr(Cells(k, 1).Value) & "(" & m & ")"
        m = m + 1
        k = k - 1
    Else
    m = 1
    k = k - 1
    End If
Next k
End Sub

Public Sub www()
    Dim a, b, i&, n&
    a = Me.[a1].CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) + Sheets(2).UsedRange.Rows.Count, 1 To 1)
    With CreateObject("scripting.dictionary"
    For i = 1 To UBound(a)
        If Not .exists(a(i, 1)) Then _
         n = n + 1: .Item(a(i, 1)) = n: b(n, 1) = a(i, 1)
    Next
    a = Sheets(2).[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        If Not .exists(a(i, 1)) Then _
         n = n + 1: .Item(a(i, 1)) = n: b(n, 1) = a(i, 1)
    Next
    End With
    Sheets(1).[a1].Resize(n, 1) = b
End Sub

             Set rRange = Worksheets("TDSheet".Range("D10:P33"
             
             With BazaSht

                iLastRow = Range("A7".SpecialCells(xlLastCell).Row
                n = iLastRow + 1
                
                For Each aCell In Range("A7", Cells(Rows.Count, 1).End(xlUp))
                    For Each rCell In rRange
                        If Len(rCell.Value) > 5 Then
                           If rCell.Value = aCell.Value Then GoTo aNext
                           Else
                                   BazaSht.Cells(n, 1).Value = rCell.Value
                                   n = n + 1
                           End If
 ---->                End If
                   Next rCell
aNext:
                Next aCell

             End With