CODEWITHSUNDEEP
vbaexcel
slomo
slomo

Reputation: 117

Macro Displays a pop-up message if the date in the cell applies today

I have a list of tasks in Excel, I want every time I open the file, and there is a cell with a date that applies today, will pop a message with the contents of the task that applies today

I tried to do this code, but it did not work

Private Sub Workbook_Open()
    For Each cell In Range("A4:A500")
        If cell.Value - today Then
            MsgBox "Here should be the text in column B"
        End If
    Next
End Sub

I would appreciate any help

Upvotes: 0

Views: 1896

Answers (3)

VBasic2008
VBasic2008

Reputation: 54767

Better late than never

Option Explicit
Sub TodaysTasks()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description
  'In a specified worksheet or the ActiveSheet, searches a specified one column
  'range and looks for today's date values and when found writes the values of
  'the next adjacent column to a string and finally outputs the string to a
  'MsgBox and to the Immediate window.
'Arguments as constants
  'cStrWorksheetName
    'The name of the worksheet. If "" then the ActiveSheet object is used.
  'cStrRange
    'The range where to search.
  'cStrTitle
    'The title of the resulting string
'Results
  'A string containing the title and the matching values of the second column.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Customize BEGIN -----------------------
  Const cStrWorksheetName = "" 'Worksheet name. If "" then ActiveSheet.
  Const cStrRange = "A4:A500"
  Const cStrTitle = "My today's tasks"
'Customize END -------------------------

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim rRng As Range
  Dim loF1 As Long 'Rows Counter
  Dim strTasks As String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Set oWb = ActiveWorkbook
  If cStrWorksheetName = "" Then
    Set oWs = oWb.ActiveSheet
   Else
    Set oWs = oWb.Worksheets(cStrWorksheetName)
  End If
  Set rRng = oWs.Range(cStrRange)
  'Set the title
  strTasks = cStrTitle & vbCrLf

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Loop through all cells (rows) in first column.
  For loF1 = 1 To oWs.Range(cStrRange).Rows.Count
  'Check if value in first column is todays date.
    If rRng(loF1, 1).Value = Date Then 'It is today's date.
      'Write value in second column to the string.
      strTasks = strTasks & vbCrLf & rRng(loF1, 2).Value
'     Else 'It is not today's date.
      'skip the row
    End If
  Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  MsgBox strTasks
  Debug.Print strTasks

End Sub

Upvotes: 0

Gary's Student
Gary's Student

Reputation: 96753

This sample has a worksheet named list:

enter image description here

This code:

Private Sub Workbook_Open()
    For Each cell In Sheets("list").Range("A4:A500")
        If cell.Value = Date Then
            MsgBox cell.Offset(0, 1).Value
        End If
    Next cell
End Sub

will show gold

Note:

  • we use Date() rather than Today()
  • we specify the worksheet to examine
  • we use Offset to get the column B contents

EDIT#1:

Because it is workbook code, it is very easy to install and use:

  1. right-click ThisWorkbook in the left-hand pane of the VBE

enter image description here

  1. select View Code
  2. paste the stuff in and close the VBE window

If you save the workbook, the macro will be saved with it. If you are using a version of Excel later then 2003, you must save the file as .xlsm rather than .xlsx

To remove the macro:

  1. bring up the VBE windows as above
  2. clear the code out
  3. close the VBE window

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

and

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

To learn more about Event Macros (workbook code), see:

http://www.mvps.org/dmcritchie/excel/event.htm

Macros must be enabled for this to work!

Upvotes: 2

Senor Penguin
Senor Penguin

Reputation: 405

Sub Test()

TodayD = Date

'define sheet
With Worksheets(1).Range("A4:A500")
    Set c = .Find(Date, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox "Here should be the text in column B: " & firstAddress
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

End Sub

Upvotes: 0

Related Questions