Const DeviceColumn As Integer = 2
Const DayColumn As Integer = 6
Const DateCheckColumn As Integer = 4
Const DateNextCheckColumn As Integer = 5
Const StartRow As Integer = 7

Const WarningPeriod As Integer = 10

Private Sub Workbook_Open5()

Dim NextCheckDate As Date
Dim LastRow As Integer
Dim ExpiredChecksPeriodCount As Integer
Dim NearestCheckPeriodCount As Integer

    With ThisWorkbook.Worksheets("Лист1")
        LastRow = .Cells(.Rows.Count, DeviceColumn).End(xlUp).Row
        .Columns(DayColumn).Interior.Pattern = xlNone
        .Range(.Cells(StartRow, DayColumn), .Cells(LastRow, DayColumn)).ClearContents
        For CurentRow = StartRow To LastRow
            If Not IsEmpty(.Cells(CurentRow, DeviceColumn)) And _
               Not IsEmpty(.Cells(CurentRow, DateCheckColumn)) And _
               Not IsEmpty(.Cells(CurentRow, DateNextCheckColumn)) Then

                NextCheckDate = CDate(.Cells(CurentRow, DateNextCheckColumn).Value)
                PreviousCheckDate = CDate(.Cells(CurentRow, DateCheckColumn).Value)
                dayToNextCheck = NextCheckDate - PreviousCheckDate
                .Cells(CurentRow, DayColumn).Value = Format(dayToNextCheck, "000")
                If dayToNextCheck > 0 Then
                    If dayToNextCheck <= WarningPeriod Then
                        .Cells(CurentRow, DayColumn).Interior.Color = vbYellow
                        NearestCheckPeriodCount = NearestCheckPeriodCount + 1
                    End If
                Else
                    .Cells(CurentRow, DayColumn).Interior.Color = vbRed
                    ExpiredChecksPeriodCount = ExpiredChecksPeriodCount + 1
                End If
            End If
        DoEvents
        Next CurentRow
    End With
    If (ExpiredChecksPeriodCount > 0 Or NearestCheckPeriodCount > 0) Then
        MsgBox ("Количество подходящих сроков поверки: " & NearestCheckPeriodCount & vbNewLine & _
                "Количество просраченых сроков поверки: " & ExpiredChecksPeriodCount)
    End If
End Sub