.DisplayAlerts = Falsе

  .ActiveWorkbook.Close False

.DisplayAlerts = False

   .DisplayAlerts = False
   .Quit

Set WshShell = CreateObject("WScript.Shell")
filebase = WshShell.CurrentDirectory & "\base.ottb"
fileOTA = "D:\WorkDrive\Квартальный отчет\2016\Макрос отчет 2 квартал\Testfile\ota110.ottb"
With  CreateObject("Excel.Application")
  .Visible = True
  .Workbooks.Open fileOTA,,,,"Passw0rd"
  .Run "ImportBase", filebase
End With

CloseWorkBook.temp = ActiveWorkBook.temp

        Dim objCloseBook As Object
        Set objCloseBook = GetObject("C:\Base\base.ottb")

Public Sub Макрос()
    Условие = "18.02.2017"
    t = Timer
    With Sheets("Закупки с учетом корректировок")
        lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arrNew = .Range("a3:Z" & lrow)
         
        Set col = CreateObject("Scripting.Dictionary")
        nrows = ""
        For i = 1 To UBound(arrNew, 1)
            For j = 1 To UBound(arrNew, 1)
                If arrNew(j, 1) = arrNew(i, 1) Then
                    If (CDate(Условие) < arrNew(j, 26)) Or (CDate(Условие) > arrNew(j, 26)) And (arrNew(j, 26) < arrNew(i, 26)) Then col.Item(j + 2) = j + 2
                End If
            Next
        Next
        Dim mass As Range
        For Each r In col
            If mass Is Nothing Then
                    Set mass = .Rows(r)
                Else
                    Set mass = Union(mass, .Rows(r))
                End If
        Next
    End With
    mass.EntireRow.Hidden = True
    MsgBox Timer - t
End Sub 

Public Sub Массив()
    Application.ScreenUpdating = False
    Dim LastLine As Variant, Условие As Date
    Dim x As Variant, y As Variant, t As Variant
    t = Timer
    LastLine = Лист5.Cells(Лист5.Rows.Count, 1).End(xlUp).Row
    x = LastLine - 2
    y = 26
    Условие = "17.02.2017"
    arrNew = Лист5.Range("a3:Z" & LastLine)
    For s = 1 To x
        For l = 2 To x - 1
            If arrNew(s, 1) = arrNew(l, 1) Then
                If Условие < arrNew(s, 26) Then
                    Лист5.Rows(s + 2).Hidden = True
                ElseIf Условие > arrNew(s, 26) Then
                    If arrNew(s, 26) < arrNew(l, 26) Then Лист5.Rows(s + 2).Hidden = True
                    ElseIf arrNew(s, 26) > arrNew(l, 26) Then Лист5.Rows(l + 2).Hidden = True
                End If
            End If
        Next l
    Next s
    Erase arrNew
    Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

Public Sub Макрос()
    Условие = "17.02.2017"
    t = Timer
    With Sheets("Закупки с учетом корректировок")
        lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arrNew = .Range("a3:Z" & lrow)
        Dim col As New Collection
        nrows = ""
        For i = 1 To UBound(arrNew, 1)
            For j = 1 To UBound(arrNew, 1)
                If arrNew(j, 1) = arrNew(i, 1) Then
                    If Условие < arrNew(j, 26) Then col.Add j + 2
                    ElseIf arrNew(j, 26) < arrNew(i, 26) Then col.Add j + 2
                End If
            Next
        Next
        Dim mass As Range
        For Each r In col
            If mass Is Nothing Then
                    Set mass = .Rows(r)
                Else
                    Set mass = Union(mass, .Rows(r))
                End If
        Next
    End With
    mass.EntireRow.Hidden = True
    MsgBox Timer - t
End Sub