Option Explicit
Sub test()
Dim dic As Object
Dim wsf As Object: Set wsf = WorksheetFunction
Dim p As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim v
Dim j As Long, k As Long
Dim c As Range
Set dic = CreateObject("scripting.dictionary")
p = ThisWorkbook.Path & "\"
Set ws1 = Workbooks.Open(p & "Book1-VBA.xlsm").Worksheets("_Summary")
Set ws2 = Workbooks.Open(p & "Book2-VBA.xlsm").Worksheets("sheet1")
v = ws1.Columns(1).SpecialCells(xlCellTypeConstants).Resize(, 4).Value
ws1.Parent.Close False
For k = 1 To UBound(v)
If v(k, 4) > 24 Then
For j = wsf.RoundUp(v(k, 2), 0) To wsf.RoundDown(v(k, 3), 0)
dic(j) = Empty
Next
End If
Next
For Each c In ws2.Rows(1).SpecialCells(xlCellTypeConstants)
If dic.exists(c.Value) Then
c.Offset(1).Interior.ColorIndex = xlNone
End If
Next
End Sub