Excel VB script to notify/popup [Solved/Closed]

- - Latest reply: rizvisa1
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Oct 15, 2011 at 07:10 AM
Hello,
I want to have different cells in the worksheet have pop up messages/notifications when the date or deadline is reached. so when the 1 june 2011 arrives there is a pop with message to remind on work that should have been received for an example.

Your assistance will greatly appreciated


See more 

2 replies

0
Thank you
anyone who can assist with the code I would appreciate it.

something close to:
Private Sub Workbook_Open()
Dim cl As Range
Set cl = ThisWorkbook.Sheets("Sheet1").Range("A1")
If IsDate(cl) Then
If Now >= cl Then
MsgBox "The date in Sheet1 cell A1 has been reached or passed."
End If
End If
End Sub


except it needs be assigned to each cell, as each cell in worksheet has different deadline dates. The above code is for the whole workbook which doesn''t meet the requirements. Thank you
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
0
Thank you
First I dont think that it is a very good idea to loop thru each cell. If you have few thousand cells, it will take some time to scan thru each cell.

However if you still want to scan thru each cell you can use some thing like this

Private Sub Workbook_Open() 
   Dim cl               As Range
   Dim lMaxRows         As Long 
   Dim lMaxCols         As Long 
    
   With Sheets("Sheet1") 
      lMaxRows = getItemLocation("*", .Cells) 
      If lMaxRows = 0 Then Exit Sub 
      lMaxCols = getItemLocation("*", .Cells, bFindRow:=False) 
      For Each cl In .Range(.Cells(1, 1), .Cells(lMaxRows, lMaxCols)) 
         If IsDate(cl) Then 
            If Now >= cl Then 
               MsgBox "The date in " & .Name & ", cell " & cl.Address(False, False) & " has been reached or passed." 
            End If 
         End If 
      Next 
   End With 
End Sub 


Public Function getItemLocation(sLookFor As String, _ 
                                rngSearch As Range, _ 
                                Optional bFullString As Boolean = True, _ 
                                Optional bLastOccurance As Boolean = True, _ 
                                Optional bFindRow As Boolean = True) As Long 
     
   Dim Cell             As Range 
   Dim iLookAt          As Integer 
   Dim iSearchDir       As Integer 
   Dim iSearchOdr       As Integer 
     
   If (bFullString) _ 
   Then 
      iLookAt = xlWhole 
   Else 
      iLookAt = xlPart 
   End If 
   If (bLastOccurance) _ 
   Then 
      iSearchDir = xlPrevious 
   Else 
      iSearchDir = xlNext 
   End If 
   If Not (bFindRow) _ 
   Then 
      iSearchOdr = xlByColumns 
   Else 
      iSearchOdr = xlByRows 
   End If 
     
   With rngSearch 
      If (bLastOccurance) _ 
      Then 
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir) 
      Else 
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir) 
      End If 
   End With 
     
   If Cell Is Nothing Then 
      getItemLocation = 0 
   ElseIf Not (bFindRow) _ 
   Then 
      getItemLocation = Cell.Column 
   Else 
      getItemLocation = Cell.Row 
   End If 
   Set Cell = Nothing 

End Function
rizvisa1
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
-
try with this line

If Format(Now, "YYYYMMDD") = format(cdate(cl), "YYYYMMDD") Then
IBZV
Posts
3
Registration date
Tuesday June 28, 2011
Last seen
July 1, 2011
-
worked great, thanks so much for the help. Best regards
rizvisa1
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
-
you are welcome
Hi
I thought youre script was great, i wonder if its possible to get a list instead of a numerous amount of popups? I have a list where a lot of dates are out of date constantly.
rizvisa1
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
-
You could write to a sheet instead of message boxes