Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA - Remove Seconds from NOW function

Tags:

excel

vba

seconds

I have something that notify me an hour before it happens. For that, I use the NOW function in VBA as I need it to check for the Date as well.

The problem is the script runs every 20 seconds so I can't have it consider seconds for the NOW function.

Is there a way to remove those? To have only like (DAY,MONTH,YEAR,HOUR,MINUTE)?

Something along those lines:

 MyLimit = NOW(DAY,MONTH,YEAR,HOUR,MINUTE)

 For Each FormulaCell In FormulaRange.Cells
 With FormulaCell
            If .Value = MyLimit Then
            Call Notify

Here is the script in which I attempt to detect the date and time.

Option Explicit

Public Function AutoRun()
Application.OnTime Now + TimeValue("00:00:20"), "TaskTracker2"
End Function

Public Sub TaskTracker2()
Dim FormulaCell          As Range
Dim FormulaRange    As Range
Dim NotSentMsg      As String
Dim MyMsg           As String
Dim SentMsg         As String
Dim SendTo          As String
Dim CCTo            As String
Dim BCCTo           As String
Dim MyLimit         As Date


NotSentMsg = "Not Sent"
SentMsg = "Sent"
SendTo = Range("D2")
CCTo = Range("E2")
BCCTo = Range("F2")

MyLimit = Format((Now), "DD/MM/YYYY HH:MM")

Set FormulaRange = Range("E5:E35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    strTO = SendTo
                    strCC = CCTo
                    strBCC = BCCTo
                    strSub = "[Task Manager] Reminder that you need to: " & Cells(FormulaCell.Row, "A").Value
                    strBody = "Hello Sir, " & vbNewLine & vbNewLine & _
                        "This email is to notify that you that your task : " & Cells(FormulaCell.Row, "A").Value & " with the following note: " & Cells(FormulaCell.Row, "B").Value & " is nearing its Due Date." & vbNewLine & "It would be wise to complete this task before it expires!" & _
                        vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager"
                    If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg

                End If
            Else
                MyMsg = NotSentMsg
            End If
        Application.EnableEvents = False
        .Offset(0, 1).Value = MyMsg
        Application.EnableEvents = True

    End With

Next FormulaCell
AutoRun

ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True

MsgBox "Some Error occurred." _
     & vbLf & Err.Number _
     & vbLf & Err.Description

End Sub
like image 713
Francis Maltais Avatar asked Oct 30 '25 09:10

Francis Maltais


2 Answers

To strip the seconds off Now, you can use some maths or to-and-from text conversion.

CDate(format(Now, "dd-mmm-yyyy hh:mm"))
'... or,
CLng(Now * 1440)/1440

Both of those return a true, numerical datetime value with the seconds stripped off. They do not average the seconds to the nearest minute; simply remove them.

You could just round MyLimit to the nearest minute:

MyLimit = Round(Now * 1440, 0) / 1440

Consider, when comparing it to the contents of a cell, that you might need to use a <= or >= comparison to avoid problems if the time changes at the "wrong" time for an equality to hold true.

like image 27
Ron Rosenfeld Avatar answered Nov 02 '25 18:11

Ron Rosenfeld