I ran some code in VBA as per https://www.thespreadsheetguru.com/the-code-vault/2015/1/28/vba-calculate-macro-run-time and had a return of a negative value:
-20439 seconds
Does anyone know why? It actually ran for ~ 18hrs (1500 - 0900 next day)
Option Explicit
Sub CalculateRunTime_Minutes()
'PURPOSE: Determine how many minutes it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Insert Your Code Here...
'*****************************
'Determine how many seconds code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub
The code uses Timer.
The Timer returns a Single representing the number of seconds elapsed since midnight. SyntaxTimerRemarks In Microsoft Windows the Timer function returns fractional portions of a second. On the Macintosh, timer resolution is one second. MSDN
Thus, if you start running at 15:00, the code would return something meaningful, if you end up to 23:59. If you end the next day at 09:00, it would return negative value.
You can rebuild the code, in order to get the date in account as well. Use Now, which returns the date and the time - 21.02.2018 10:33:55
This looks like a good possible alternative:
Sub WorkstAtMidnight()
Dim StartTime As Date
StartTime = Now()
'Do something incredible
MsgBox Round((Now() - StartTime) * 24 * 60 * 60, 0)
'24 hours times 60 minutes times 60 seconds (usually I just do 24*3600)
End Sub
Another alternative:
MinutesElapsed = Format((Timer - StartTime) / 86400 + IIf(Timer < StartTime, 1, 0), "hh:mm:ss")
This keeps track of the hours and minutes accurately up to a whole day (i.e. it resets at 24 hours of runtime). After which the real question is why does your code take so long!
hopefully this is a silly question with an easy answer.
I have no choice really what language I use, which is why I'm doing this in Excel with VBA.
I'm basically calculating total downtime hours over a month. I need to add small amounts of minutes together to find out a total that will be over 24 hours of course.
Here is the scenario:
Server A was down for 3 hours and 52 minutes this month.
Server B was down for 15 hours and 25 minutes this month.
Server B had 7 hours and 23 minutes downtime during a critical period, so this is multplied by 3 to equate it to non-critical downtime.
Server A has: 3 hours 52 minutes at x1
Server B has: 8 hours 2 minutes at x1
Server B has: 7 hours 21 minutes at x3
All downtimes and restoration times are manually listed in a sheet in time formats recognised by excel, eg:
event 1 : 19/11/2017 5:00 : 19/11/2017 14:12
event 2 : 13/11/2017 6:00 : 13/11/2017 6:40
event 3 : 13/11/2017 7:57 : 13/11/2017 9:01
event 4 : 17/11/2017 6:15 : 18/11/2017 8:10
Weekends are not counted
Only minutes between 6am and 6pm are counted
Minutes increase in priority during certain time periods:
06:00-07:00, 07:00-09:00, 09:00-10:00, 10:00-14:00
High priority minutes are multiplied to equate peak time usage with lower standard time usage
I'm struggling to find a way to add times together to count hours, excel trys to give answers relative to 01/01/1900 or some "real" date.
I'm going the opposite way, I have the real dates, I need to work with the hours between them. Is there a data format that is in plain hours:minutes?
I thought it was obvious but I'll state clearly in case, start time and end times are not necessarily on the same day. They can be any time, any relationship, sometimes start time will be after the end time due to how faults are reported. Obviously that counts as 0 minutes in that case.
My current methodology for attacking this problem is:
increase the start time until it becomes valid charge time
calculate the minutes until there is a change such as end of day or higher priority time slot, or start time = end time
add the calculated minutes to a total
increase the start time by the calculated minutes
start cycle again from the the new 'start time' and loop until there are no minutes remaining between start time and end time
startof:
'move to start of next chargeable day, if not on a chargeable day
'eg weekends, public holidays, easy function to write
Do While testForChargeable() = False
opnDate = DateAdd("d", 1, opnDate)
opnTime = "06:00"
Loop
'check if open time is past the end of chargeable time, 18:00
If (opnTime >= endofdayTime) Then
'move to start of next chargeable day
opnDate = DateAdd("d", 1, opnDate)
opnTime = "06:00"
End If
'check if open time is after close time and fault is excluded
If (opnDate >= bisDate) And (opnTime >= bisTime) Then
GoTo last
End If
'check if close time is on same day as start time
If DateDiff("d", opnDate, bisDate) = 0 Then
'if it is, add minutes between opntime and bistime
chargeTime = chargeTime + calculateChargeTime(opnTime, bisTime)
'calculation ends, loop naturally terminates
Else
'if not, add remaining mintes of day to chargeable time
chargeTime = chargeTime + calculateChargeTime(opnTime, endofdayTime)
'move to start of next day
opnDate = DateAdd("d", 1, opnDate)
opnTime = "06:00"
GoTo startof
End If
last:
Cheers
Edit: Now that we're on the same page and I have what I think is a workable solution for you, I'll replace my previous answer [re: How Excel dates are related to value (ie., 1 day = 1)] with this one. The previous answer (and my computer messing up while trying to post it) is viewable in the Edit History.
So, you need a way to count minutes duration, between two DateTimes, and include or exclude sub-time-ranges based on criteria that might require ongoing adjustment, and you want this in a VBA function for use in automation of downtime data analysis.
Try this:
Option Explicit
Function MinsBetween(startDateTime As Date, stopDateTime As Date, count_StartTime As Date, count_StopTime As Date) As Long
Dim startTime As Date, stopTime As Date
'ignore dates, use only the times
startTime = startDateTime - Int(startDateTime)
stopTime = stopDateTime - Int(stopDateTime)
If startTime >= count_StopTime Or stopTime <= count_StartTime Then
'entire period falls outside of times to count
MinsBetween = 0
Exit Function
End If
'make 'adj' times start/end at counted times if necessary
startDateTime = IIf(startTime < count_StartTime, count_StartTime, startTime)
stopDateTime = IIf(stopTime > count_StopTime, count_StopTime, stopTime)
'calculate & return minutes between (never return negative number)
MinsBetween = Abs(DateDiff("n", startDateTime, stopDateTime))
End Function
This function counts only the minutes between startDateTime and stopDateTime that also fall between count_StartTime and count_StopTime.
Expects:
- count_StartTime & count_StopTime to be an Excel Time (or number between 0 and 1)
- startDateTime & stopDateTime to be an Excel Time or DateTime.
Returns a long integer. Could be referenced in VBA or as a worksheet function.
Example usage:
The outage 'event' occurred from 05:00 to 07:03 on 2017/11/19, but only the times between 6am and 6pm should be counted:
Debug.Print MinsBetween("2017/11/19 05:00", "2017/11/19 07:03", "06:00", "18:00")
The outage 'event' occurred from 05:00 to 14:12 on 2017/11/19. The duration that occurred between [peak period] 1pm to 2pm are have higher priority and should be counted as "double-time":
Debug.Print (2 * MinsBetween("2017/11/19 05:00", "2017/11/19 14:12", "13:00", "15:00") )
As weekends are ignored entirely, those reports could be excluded with a simple check like this:
Function isWeekend(wDateTime As Date) As Boolean
isWeekend = Weekday(DateValue(wDateTime)) = vbSaturday Or Weekday(DateValue(wDateTime)) = vbSunday
End Function
...returns TRUE if the supplied date (or datetime) falls on a weekend, otherwise returns FALSE.
You could use a combination of these functions to build sub or worksheet function around your custom criteria and adjust as needed.
For example:
Function DownTimeMinutes(startDateTime As Date, stopDateTime As Date) As Long
'you could process your custom criteria for each start/stop period here
Dim dtMinutes As Long
'for example:
'IGNORE DOWNTIME ON WEEKENDS
If isWeekend(startDateTime) Then
'ignore weekeends
DownTimeMinutes = 0
Exit Function
End If
'COUNT MINUTES BETWEEN 6AM-6PM with "x1" multiplier
dtMinutes = MinsBetween(startDateTime, stopDateTime, "06:00", "18:00")
'DON'T COUNT LUNCH BREAK (or something like that)
'(subtract these minutes from total)
dtMinutes = dtMinutes - MinsBetween(startDateTime, stopDateTime, "12:00", "12:30")
'COUNT MINUTES BETWEEN 14:00-15:00 as "x3"
'(already counted as "x1" so add "2x these minutes"
dtMinutes = dtMinutes + (2 * MinsBetween(startDateTime, stopDateTime, "14:00", "15:00"))
'return adjusted minutes for this downtime event
DownTimeMinutes = dtMinutes
End Function
Side note: This is the short-story of the long-example I was getting at when I thought part of your issue was trouble converting varying M/D/Y , MM/DD/YY , M-DD-YYYY , etc, manual entries to DateTimes that Excel would recognize regardless of the user's Regional date settings.
As I understand it, you don't need it now but I figured I might as well add it to my answer anyway :
=DATE(MID(RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))),FIND("/",RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))))+1,4),LEFT(RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))),FIND("/",RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))))-1),FIND("/",RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1))))))+TIMEVALUE(RIGHT(A1,LEN(A1)-FIND(" ",A1)))
Generally I don't condone the use of gigantic formulas (I was more concerned about getting it into a single function that about readability), and there are other ways to deal with date issues caused by Regional differences in shared workbooks (including Windows API) but in most cases I find text manipulation will do the job too.
How can I round off date and time in excel using VBA?
For example, the user selects the value from the calendar which is copied in Cell A6 = "08/25/2016 09:02:00"
I am pulling the data in 15 minutes interval so I want it to be A6 = "08/25/2016 09:00:00"
So if the user selects any date and time that is not in multiple of 15 minutes, it should go back to the previous 15 minute interval value and pull the data.
Pull out the minutes, floor the date portion to get rid of the time, then add it back by building it with TimeSerial:
Private Sub Example()
Dim foo As Date
foo = CDate("08/25/2016 09:02:00")
Dim minutes As Long
minutes = Minute(foo)
minutes = 15 * (minutes \ 15) 'Round down by 15 minute increments
foo = Int(foo) + TimeSerial(Hour(foo), minutes, 0)
Debug.Print foo
End Sub
Edit: Like #Pekka mentions, this can be done with a worksheet formula too - this is the equivalent to the code VBA above:
=INT(A6)+TIME(HOUR(A6),INT(MINUTE(A6) / 15) * 15, 0)
VBA is not necessary. This can be done directly in Excel. =FLOOR(A6,TIME(0,15,0)) will truncate a date time value to the previous 15 minute value.
Excel represents date values as a floating point value since an initial date (around 1900, depending on version) with the time as the fractional portion of the value.
You could, of course, use the same expression in VBA code in the same way.
As Jeeped comments, this is a more self-documenting alternative to the more direct expression =int(A6*24*4)/4/24 initially suggested.
A bit shorter version of the other answers
=MRound(A6, 1/96)
which in VBA can be
[a6] = [MRound(A6, 1/96)]
or to round down
[a6] = [Int(A6*96)/96]
I created an alarm clock with VB form and I noticed that the timer hangs up if I open another app like Chrome browser. If it hangs at 55 sec and then restarts at 05 sec then my clock will have missed 1 min because the minutes only change when the seconds hit 00. Any ideas?
You shouldn't check for second 0 for the exact reason you are having the problem. Keep a variable of the last execution date. And execute your code if it's been over 1 minutes since the last execution date.
Dim previousExecution As DateTime
Dim closestExecution As DateTime
' ...
' Get current time minus seconds
closestExecution = DateTime.Now
closestExecution = closestExecution.AddSeconds(-closestExecution.Second)
If previousExecution < closestExecution Then
' Execute your code
previousExecution = closestExecution
End If
I'm using Excel 2010 and writing a VBA script that needs to do something if the value is a Cell is between now and in 24 hours. I've looked through dozens of topic and couldn't find a way to efficiently do this.
Here are a few things you need to know.
The script looks for the value (Due Date) in a formula range:
Set FormulaRange = ThisWorkbook.Worksheets("Tasks").Range("F5:F35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
Let's say that F5 has the following value:
3/9/2016 9:50:00 AM
I am then trying to ask it to do "MyMsg = SentMsg" if the value in range F5:F35 is equal to now or in 24 hours.
Below are a few ways I tried it, and have been unsuccessful at doing so.
1. Doesn't work as it does not consider hours and minutes. It does trigger if the date is tomorrow though, but I need it to check for 24 hours, not +1 day).:
If DateValue(CDate(.Value)) >= Date And DateValue(CDate(.Value)) <= (Date + 1) Then
2. Then I tried to Round Down Now() to the last minute (and adding 1440 minutes for a full day) as the script autoruns itself every minute to check for trigger dates using:
If DateValue(CDate(.Value)) >= Date And DateValue(CDate(.Value)) <= ((Round(Now * 1440, 0) +1440) / 1440) Then
2. Doesn't work as it triggers even if there are more than 24 hours, but doesn't if there is more than 30 hours? (This confuses me). This might be due to me using >= Date? I need to make sure it does send a reminder between Today's 0:00 AM and now + 24 hours.
3. I also tried to use the following but the result is the same as number 2:
If DateValue(CDate(.Value)) >= Date And DateValue(CDate(.Value)) <= (Now + TimeSerial(24, 0, 0)) Then
Am I overthinking this? Is there a easier, simpler way to do this, and if not. What am I doing wrong?
I believe one of the problem is that I can't use between Now and Now + something. Because the script removes the trigger if it is past Now(), so it really has to be a general date and now + time.
Any help will be greatly appreciated, I'm completely stuck there.
Thanks,
Francis M.
There are two possible ways to add 24 hours to the current DateTime (i.e. Now) in Excel VBA; code snippet below demonstrates the use of these functions and also includes a sample IF check based on the condition that the date value in cell "A3" is between Now and (Now+24hrs):
Sub Add24h()
' one possible solution to add 24 hrs
Range("A1").Value = Now + TimeSerial(24, 0, 0)
' another possible solution to add 24 hrs
Range("A2") = DateAdd("h", 24, Now)
'sample logical statement to check if the value is in between two of dates
If (Range("A3") >= Now And Range("A3") <= (Now + TimeSerial(24, 0, 0))) Then
' place you code here
End If
End Sub
The same functionality could be achieved by using Excel Worksheet functions, like shown below:
=IF(AND(A3>=NOW(),A3<=NOW()+1),TRUE,FALSE)
Hope this may help.