POP UP message creation

[arnab0711]

Hi All,
I want to create a pop up message showing count of cells turned red,each time the workbooked are opened.like column "I" has two dates in red colour,so the pop up will say
"you have 2 contracts expired"

[DonkeyOte]

Given the "red cells" simply equate to count of Today I would suggest you run a COUNTIF (of Date / Today() pending which route you take) via the Open Event against whichever ranges are of interest.

[arnab0711]

I am not able to do that,can you help me please

[DonkeyOte]

Well it's not clear if you need to test multiple ranges or just Column I on KolWB sheet but in the most basic of terms:

Private Sub Workbook_Open()
MsgBox Sheets("KolWB").Evaluate("COUNTIF(I:I,TODAY())")
End Sub

the above would reside in ThisWorkbook object in VBEditor.

[arnab0711]

Thanks for the reply,but the only thing I want is on file open,the comment should be shown,and the comment will be "the # of contracts expired are contract #"

[D_Rennie]

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

[arnab0711]

Hi,I am getting this error "Invalid or unqualified reference" on first formula
and nothing is happening in the second formula

[DonkeyOte]

The first code should just be:

Private Sub Workbook_Open()
Dim Count As Long
Count = Sheets("KolWB").Evaluate("COUNTIF(I:I,TODAY())")
If Count Then MsgBox "you have " & Count & " contracts expired"
End Sub

[arnab0711]

Thanks,its working now