Excel VB script to notify/popup

Solved/Closed
dimi - Jun 1, 2011 at 01:46 PM
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - 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


2 replies

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
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jun 1, 2011 at 02:15 PM
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
0
thank you very much, will try this
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jun 1, 2011 at 02:57 PM
Good Luck
0
IBZV Posts 3 Registration date Tuesday June 28, 2011 Status Member Last seen July 1, 2011
Jun 29, 2011 at 09:47 AM
I used your code and it works like a charm, but i was wondering if it can be modified so that it only pop's up with cells that equal exactly today's date without including cells with dates that have already passed, i would really appreciate the help, thanks in advanced.
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jun 29, 2011 at 07:36 PM
Change this line
If Now >= cl Then
to
If Now = cl Then
0
IBZV Posts 3 Registration date Tuesday June 28, 2011 Status Member Last seen July 1, 2011
Jun 30, 2011 at 08:27 AM
changed that line and now it doesn't seem to work, sorry for the inconvenience.
0