Match NOW() with cell formatted as date

[Juriemagic]

Hi good people!,

I have in a cell the "NOW()" formula and in another cell date and time formatted as "dd-mm-yyyy hh:mm". If I change the date and time in this latter cell lets say one minute ahead of the "NOW" formula, and wait for the NOW to reach the same date/time, I would expect the two cells to equal (TRUE) to one another, but for some reason they do not. I have noted that even with the latter cell formatted to NOT show "seconds", it actually displays the seconds a 00. Could this maybe be the cause?..I would appreciate any help with this teeny thibg..Thanx a lot..

[Paul_Hossler]

1. Now() will only update when the worksheet is recalculated

2. The chances of an 'Equal' would seem to be very small. Maybe a Greater Than would work

[Juriemagic]

Hallo Paul_Hossler,

I have a counter running permanently on the sheet, so the NOW() stays live. I need to log only at a certain time, I'm afraid a greater or smaller will have the logging just going on and on. BUT what I have done in the meantime is I have put "YEAR", "MONTH", "HOUR" and "MINUTE" formulae in 4 cells next to the two date/times. I now monitor all 4 criteria and once all 4 match, the code executes. The code I have is:

Private tmr_tm As Date
Private tmr_src As Range
Private tmr_dst As Range

Private Sub tmr()
    Do
        If tmr_src = 0 Then Exit Sub
        tmr_dst = "'" & Format(Now - tmr_tm, "hh:mm:ss")
        DoEvents
    Loop
End Sub

Private Sub Worksheet_Calculate()
If Range("C7").Value = 1 Then
Range("C3").Select
    Selection.Copy
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    msgbox "Data Logged"
    Range("A1").Select
    Application.CutCopyMode = False
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If tmr_src Is Nothing Then Set tmr_src = Range("a1") '<-- cell to check
    If tmr_dst Is Nothing Then Set tmr_dst = Range("a2") '<-- time display
    If Target.Address = tmr_dst.Address Then Exit Sub
    If Target.Address = tmr_src.Address Or tmr_tm = 0 Then tmr_tm = Now
    tmr
If Target.Address = "$A$1" Then
If Range("A1").Value = 1 Then
Range("C6").Select
    Selection.Copy
    Range("C7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
  End If
  Exit Sub
  If Range("A1").Value = 0 Then
Exit Sub
  End If
End If
   End Sub

all works, BUT, after execution the messagebox does not come up and also if I dare touch A1 to stop the counter, excel crashes...Would you please be so kind to see where I have gone wrong?

[SamT]

I would expect the two cells to equal (TRUE) to one another

NOW is calculated to about 11 decimal places.

I need to log only at a certain time,

Once a day? Same time every day?

Private Sub tmr()
Dim LoginTime As Double

LoginTime = TimeSerial(Hour:=23, Minute:=59, Second:=59)
    Do
        If Time > LoginTime Then
          MsgBox "Time to log in!"
          Exit Sub
        End If
    Loop
End Sub

Date is not critical: Enter Time in B1 ("hh:mm:ss")

Private Sub tmr()
   Do
        If Time > Range("B1").Value Then
          MsgBox "Time to log in!"
'Alternative: Login every (4) hours
Range("B1").Value = Range("B1").Value + TimeSerial(4, 0, 0)
        End If
    Loop
End Sub

Date is critical: Return only date or time from Date/Time Cell

CellDate = Int(Cell.Value)
CellTime = Cell.Value -Int(Cell.Value)

[Juriemagic]

Hi SamT,

Midnight, every 25th of March, June, September and December. Thanx for replying..

[SamT]

Then I would take the timer part out of excel and give it to Windows using Window's Scheduled Tasks Function.

Set Scheduled Tasks to run your LogIn Workbook at the time needed only on the months needed. If you can Script, schedule a script to run a particular Procedure in a particular Module in a particular Workbook.

Excel doesn't even need to be open when the scheduled time occurs.

Not to mention how much faster this will make the workbook without sub tmr running all the time.

[Juriemagic]

I see, golly, did not know all this could be done. I know the absolute minimum when it comes to scripting...I guess I will have to google on that and see what I find..Thanx for the direction you put me on!..much appreciated!

[SamT]

You can just use Window's Scheduling to open the Workbook, then in the Workbook Open Procedure

'
'
CheckLogin
'

'

Very simply and with no "slip ups" testing

Sub CheckLogIn()
If Month(Now) Mod 3 = 0 (And (Day(Now) = 25 And Time(Now) > TimeSerial(23, 50, 00)) _
Or (Day(Now) = 26 And Time(Now) < TimeSerial(00, 10, 00))) Then LoginProcedure
End Sub

[Juriemagic]

Hi SamT,

was away for couple of days..thank you for the extra help..will definitely follow this advice...thank you kindly..

[SamT]

Two issues you need to know.

1: Using Window's Scheduling and the Workbook_Open event means Excel must be closed in order to work.

2 Using VBA's OnTime Method means Excel must be open at that time in order to work.


You can use Scheduling to open a different workbook that checks to see if the Login book is open, If not then opens it, and Calls the Login procedure in the Login Book.

Use Scheduling to insure the login book is open and use OnTime to run the login procedure. Opening an open workbook should not cause any problems, but test.

Write a Workbook_BeforeClose Sub to remind you to leave the book open on those days so OnTime can work.

[Juriemagic]

I understand what you're saying, thanx again SamT..however, should I ran into some difficulty, may I press your button again on this issue?

[Juriemagic]

SamT,

No, I am not floating here..please, I need to be fed with a teaspoon, so to speak. From the last post to this very second I have tried, read on the internet, but I just do not get it. Please help me:

What I did manage was to create a Windows scheduled task, to open the workbook. This works nicely. I was thinking to have the workbook opened 5 minutes before Logging time...So the book is opened 23H55. At midnight (more or less), the copying and pasting needs to be done. I am struggling to get vba to check for the date and time "constantly", so when the time arrives, and the month and day are correct, the execution can happen.
I know I am not the brightest out there, I admit...please help me if you don't mind?

[SamT]

Tell me about the way you use the Login book. Is it open all the time? Do you close it daily.

It makes a difference in how a quarterly schedule is coded.

After some consideration and research, I think the best bet for a beginner is to use two workbooks, the one you have now, which for convenience, I will call the Login Book and a new book, which I will call the Scheduled book.

It will require no changes to the Login book except that it should be set up so that you can run one macro that does all the work.

The Scheduled book would be opened by Window's Scheduling and it would check to see in the Login book is already open; If not, it would open Login then call the macro/sub in the Login book that does all the work.

Windows would be taking care of the months and close to the time. The Scheduled book can time it so that the actual Login Procedure is called at exactly midnight or as soon after as possible.

[Juriemagic]

Thank you for coming back to me..well, you see, this Login book is used by another user, I have created this for him. I would imagine that he might have the book closed at logging times, and opened at other logging times, (Hope this makes sense)..

I have currently tried to use just the one book, (the login is also the scheduled),but maybe as you suggested, we should go with two books. okay, so the Scheduled book is no problem for me to put in place, just to get the proper coding to get the magic done..

[Juriemagic]

Hi SamT

I have put this code together, in the workbook_open module of the Scheduled book. It opens the Login book, copies the range, but does not do the pasting...the code is:

Dim wb As Workbook
      Application.ScreenUpdating = False
    Set wb = Workbooks.Open("H:\Schedule\Login.xlsx", ReadOnly:=False)
    Range("A1:A5").Copy
    
    Dim ws1 As Worksheet
      
    Set ws1 = Sheets("Sheet1")
    With ws1.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
    .Resize(5, 1).Value = ws1.Range("A1:A5").Value
        wb.Save
       wb.Close False
    Set wb = Nothing
    Application.ScreenUpdating = True
End With

Please if you don't mind, help me with this..thank you kindly

[Juriemagic]

SamT, no worries,

got it figured out, the final code is:

Private Sub Workbook_Open()
 Dim wb As Workbook
 Dim sht As Worksheet
      Application.ScreenUpdating = False
    Set wb = Workbooks.Open("H:\Schedule\Login.xlsx", ReadOnly:=False)
    Set sht = wb.Sheets("Sheet1")
    Range("A1:A5").Copy
    
     With sht
        .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        wb.Save
       wb.Close False
    Set wb = Nothing
    Application.ScreenUpdating = True
End With
End Sub

Thanx for all your help..have a nice day..

[snb]

That's a lot of code for a simple task:

Private Sub Workbook_Open() 
  with Getobject("H:\Schedule\Login.xlsx") 
    .Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).resize(5).value=activesheet.Range("A1:A5").value
    .close -1
  end with
End Sub

[Juriemagic]

You see, this is exactly the difference between those who know, and those who want to know..thanx snb, I do appreciate!

[SamT]