hello,

I think What DO has suggested may be the simplest solution and doesnot over complacate things.

You could try either of these. You can only have one Private Sub Workbook_Open() in the workbook at a time.
Private Sub Workbook_Open()
Dim Count As Long
Count = Sheets("KolWB").Evaluate("COUNTIF(I:I,TODAY())")
If Count < 0 Then MsgBox "you have " & .Evaluate("COUNTIF(I:I,TODAY())") & " contracts expired"
End Sub

Private Sub Workbook_Open()
Dim Rng As Range
Dim Rw As Range
On Error Resume Next
With Application
    .ScreenUpdating = False
    .EnableEvents = False
        With Sheets("KolWB")
            .UsedRange.AutoFilter Field:=9, Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
            Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(2, .Columns.Count).End(xlToLeft).Column) _
                    .SpecialCells(xlCellTypeVisible)
            If Rng <> "" Then
            For Each Rw In Rng
                 MsgBox ("Contract " & .Cells(Rw.Row, 1) & " Have Expired"): 'or remove this line and use the next
                 '.Cells(Rw.Row, 1).Interior.Color = 65535
                Next Rw
                'MsgBox "you have " & Evaluate("COUNTIF(I:I,TODAY())") & " contracts expired"
            End If
            .AutoFilterMode = False
        End With
    .ScreenUpdating = True
    .EnableEvents = True
End With
On Error GoTo 0
End Sub
Take a look and try the suggested highlighting and simgle msgbox

hope this helps

cheers