Please help me out in creating simple but tricky macro.

sanchit16

New member
Joined
Feb 1, 2012
Messages
11
Reaction score
0
Points
0
Location
New Delhi,India
Please help me out in creating simple but tricky macro.

I need to compare real time/pc time with the time present in the sheet column 'e'. With a alert message when it crosses the time.

"note: I dnt need any trigger or button to run it i need that when i open the sheet it automatically start checking the time and when the time crosses it genrate the alert ."

all the requirements are mentioned in the attached sheet.[pfa]

hope someone can help me out.

:)
 

Attachments

  • sample.xlsx
    10.1 KB · Views: 27

Ken Puls

Administrator
Staff member
Joined
Mar 13, 2011
Messages
2,520
Reaction score
5
Points
38
Location
Nanaimo, BC, Canada
Website
www.excelguru.ca
Excel Version(s)
Excel Office 365 Insider
Hi Sanchit,

Okay, so here's what I did:
  • Added a formula to I3 (although could be anywhere): =TIME(HOUR(NOW()),MINUTE(NOW()),0)
  • Named that cell "rngTime"
  • Named cells E2:E39 "rngTimes"
  • Set up a conditional format to check if the times in the list were less than the current time and turn the cell red if so.
This will give us a method to compare the current time with your list. Because the formula used is volatile, it will update every time the workbook opens or is recalculated.

Next I added the following macros:

In the THISWORKBOOK module:
Code:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off onTime calls
     Application.OnTime dTime, "Recalc", , False
End Sub

Private Sub Workbook_Open()
  dTime = Now + TimeValue("00:01:00")
  Application.OnTime dTime, "Recalc"
End Sub

In a STANDARD module:
Code:
Option Explicit
Public dTime As Date

Public Sub Recalc()
Dim cl As Range

dTime = Now + TimeValue("00:01:00")

 With Worksheets("Sheet1")
    .Calculate
    
    For Each cl In .Range("rngTimes")
        If cl.Value = .Range("rngTime").Value Then
            MsgBox "It is time for activity " & cl.Offset(0, -4).Value
        End If
    Next cl
 End With

Application.OnTime dTime, "Recalc"

End Sub

And that should do it. The macro on open kicks off a recalc one minute after opening. That macro then calls itself every minute to update the worksheet and check if any cells match the current time.

The workbook before close unloads the macro.

Sample workbook attached.
 

Attachments

  • sample.xlsm
    21 KB · Views: 23

sanchit16

New member
Joined
Feb 1, 2012
Messages
11
Reaction score
0
Points
0
Location
New Delhi,India
thanks a lot Ken,it really helps.

Can it be possible to add a sound alert (as in windows we have some alert .wav files )also so that it intimates easily.

It will run with the alert.
 

Ken Puls

Administrator
Staff member
Joined
Mar 13, 2011
Messages
2,520
Reaction score
5
Points
38
Location
Nanaimo, BC, Canada
Website
www.excelguru.ca
Excel Version(s)
Excel Office 365 Insider
Yes, that's possible.

Create a new module and put this in the top:
Code:
Option Explicit 
 'API Declaration
Private Declare Function MessageBeep& Lib "user32" (ByVal wType As Long) 
 
 'Enumeration of the beep types
Public Enum BeepTypes 
    MB_OK = &H0& 
    MB_ICONASTERISK = &H40& 
    MB_ICONEXCLAMATION = &H30& 
    MB_ICONHAND = &H10& 
End Enum 
 
Public Function BeepType(lSound As BeepTypes) As Long 
     ' Function to return
    BeepType = MessageBeep(lSound) 
End Function

Now, in the module that you already have, right after this line:
Code:
MsgBox "It is time for activity " & cl.Offset(0, -4).Value

Add this:
Code:
BeepType (MB_ICONHAND)

You can try any of the MB_ items in the public ENUM list from above.

(Code courtesy of http://www.vbaexpress.com/kb/getarticle.php?kb_id=771)
 
Top