Excel VBA Adding 1 hour to a date / time string - vba

I have a text string that looks like this: "06/10/15 4:53pm". I want to add 1 hour (60 minutes exactly) to the text string looks like this: "06/10/15 5:53pm"
Any suggestions would be appreciated.

Convert it to a date, add an hour, and convert back to string using format
Private Sub TestIt()
MsgBox AddHour("06/10/15 4:53pm")
End Sub
Public Function AddHour(ByVal sTime As String) As String
Dim dt As Date
dt = CDate(sTime)
dt = DateAdd("h", 1, dt)
AddHour = Format(dt, "mm/dd/yy h:nnam/pm")
End Function
Reference:
VBA CDate Function
VBA DateAdd Function
VBA Format Function

No VBA needed...assuming the time value above(06/10/15 4:53pm) is in cell A1 the Formula you are looking for is:
=A1+TIME(1,0,0)

Since you asked for a VBA solution:
s = "06/10/15 4:53pm"
MsgBox CDate(s) + 1 / 24

For operations with date and time in VBA is DateAdd function. You can find how to use it in this link: https://www.techonthenet.com/excel/formulas/dateadd.php

Related

Getting all the dates between two selected dates

Good afternoon, I'm new to programming and I'm working with VB.NET.
I need to get the difference between two dates and then list all the intermediate dates in listbox1. I tried the following code but it doesn't work.
Private Sub breaks()
Dim date1 As Date = DateTimePicker1.Value.ToString("dd/MM/yyyy")
Dim date2 As Date = DateTimePicker2.Value.ToString("dd/MM/yyyy")
While date1 <= date2
Dim result = date1
ListBox1.Items.Add(result)
Dim term = 1
date1 = DateTimePicker1.Value.AddDays(term)
End While
End Sub
The function is called within a button. When executed it only shows the sidebars but is blank.
The image shows start date 03/10/2020 and end date 03/16/2020, however the result (listbox) does not return anything.
I expected my result to come:
03/10/2020
03/11/2020
03/12/2020
03/14/2020
03/15/2020
03/16/2020
the interval between them.
Can anyone tell me what's wrong?
You can use some linq for a simple solution
ListBox1.DataSource =
Enumerable.Range(0, 2 + DateTimePicker2.Value.Subtract(DateTimePicker1.Value).Days).
Select(Function(offset) DateTimePicker1.Value.AddDays(offset)).
ToList()
It generates a list of numbers to act as the offset from the initial date, then adds them the specified number of times (different between the dates in days) to create all the dates. No loop required.
Credit to this answer
Edit:
This can also be similarly applied to a DataGridView, but in order to make a single column, we would need to select an anonymous type.
DataGridView1.DataSource =
Enumerable.Range(0, 2 + DateTimePicker2.Value.Subtract(DateTimePicker1.Value).Days).
Select(Function(offset) New With {.Date = DateTimePicker1.Value.AddDays(offset)}).
ToList()
You should avoid using strings for datetimes until they need to be text.
The variable date1 can be used for all the dates, like this:
Dim date1 As Date = DateTimePicker1.Value
Dim date2 As Date = DateTimePicker2.Value
While date1 <= date2
ListBox1.Items.Add(date1.ToString("MM/dd/yyyy"))
Dim term = 1
date1 = date1.AddDays(term)
End While
Also, you should make sure to set Option Strict On as the default for new projects, and set it for the current project.

Microsoft word VBA Expiration Date

Looking to change this Microsoft Word VBA Code so that the expiration date is always every Monday of the week, not a specific date:
Sub MyMacro()
ExpirationDate = #6/1/2013#
If Now() < ExpirationDate Then
'Rest of macro goes here
End if
End Sub
Any thoughts on how to do this would be great :)
If Weekday(Date) = 2 Then ... 'Monday
Public Function FindMonday(dt As Date) As Date
Do Until WeekdayName(Weekday(dt)) = "Monday"
dt = DateAdd("d", 1, dt)
Loop
FindMonday = dt
End Function
ExpirationDate = (Date + 7) - (Weekday(Date) - Weekday(vbMonday))
This formula will always return the date of next Monday, as specified by "+7"
You don't need to declare the variable Expirationdate.
If Date < (Date + 7) - (Weekday(Date) - Weekday(vbMonday)) Then
will do the job.
Note that Now returns a date/time value whereas Date returns a date integer. If time is of the essence you would have to add it in. Add 0.5 to the above formula to fix the expiration time on next Monday, 12 noon.
I'd usually use this function:
Public Function PreviousMonday(CurrentDate As Date) As Date
PreviousMonday = CurrentDate - Weekday(CurrentDate - 2)
End Function
You can then call it as:
PreviousMonday(Date()) - would return 24/07/2017 if entered today (28th).
PreviousMonday(CDATE("1 July 2017")) - would return 26/06/2017
PreviousMonday(42430) would return 29/02/2016 (42430 = 1st March 2016).

Get the last day of month

I want to get the last day of the month.
This is my code. If I want to debug it and compile it to the database it says it has an error in the syntax.
Public Function GetNowLast() As Date
Dim asdfh As Date
asdfh = DateValue("1." _
& IIf(Month(Date) + 1) > 12, Month(Date) + 1 - 12, Month(Date) + 1) _
&"."&IIf(Month(Date)+1)>12 , Year(Date)+1,Year(Date))
asdf = DateAdd("d", -1, asdf)
GetNowLast = asdf
End Function
GD Linuxman,
Let's focus on obtaining the result...:-)
See also: here
The comment by #Scott Craner is spot on ! Though strictly speaking there is no need to use the formatting. (Assuming you want to work with the 'Date' object)
To achieve what you want, setup the function as per below:
Function GetNowLast() as Date
dYear = Year(Now)
dMonth = Month(Now)
getDate = DateSerial(dYear, dMonth + 1, 0)
GetNowLast = getDate
End Function
You can call the function in your code as:
Sub findLastDayOfMonth()
lastDay = GetNowLast()
End Sub
Alternatively, and neater is likely:
Function GetNowLast(inputDate as Date) as Date
dYear = Year(inputDate)
dMonth = Month(inputDate)
getDate = DateSerial(dYear, dMonth + 1, 0)
GetNowLast = getDate
End Function
You can call that function and pass it an input parameter.
Sub findLastDayOfMonth()
lastDay = GetNowLast(Now()) 'Or any other date you would like to know the last day of the month of.
End Sub
See also this neat solution by #KekuSemau
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d1 As String
Set Rng = Range("A2")
d1 = Range("a2").Value2 'put a date in A2 Formatted as date(cell format)
Dim years
Dim months
Dim end_month
years = year(d1)
months = month(d1)
end_month = Day(DateSerial(years, months + 1, 1 - 1)) 'add one month and subtract one day from the first day of that month
MsgBox CStr(end_month), vbOKOnly, "Last day of the month"
End Sub
I realize this is a bit late into the conversation, but there is an already available worksheet function that gives the end of month date, EoMonth().
Pasting into the Immediate Window:
?Format(CDate(WorksheetFunction.EoMonth(Date, 0)), "dd")
Will return the last day of the month based on current date.
As a UDF, it makes sense to give it a default Argument:
Function LastDay(Optional DateUsed As Date) As String
If DateUsed = Null Then DateUsed = Date
LastDay = Format(CDate(WorksheetFunction.EoMonth(DateUsed, 0)), "dd")
Debug.Print LastDay
End Function
If you feed it Arguments, be sure that they are Date Literals (i.e. Enclosed with #s)
LastDay(#3/10#)
Result: 31
LastDay #2/11/2012#
Result: 29 '(A leap Year)
Note the output Data Type is String (not Date) and that the format of the date can be adjusted as needed (Ex: "mm/dd/yyyy" instead of "dd").
If the Date Data Type is needed, use:
Function LastDay(Optional DateUsed As Date) As Date
If DateUsed = 0 Then DateUsed = Date
LastDay = WorksheetFunction.EoMonth(DateUsed, 0)
Debug.Print CDate(LastDay)
End Function
I hope that helps someone.
In short, a great and straightforward approach is to find the first day of the following month and then move backward one day.
Make yourself a little function that does something like this:
Obtain the month and year in question (the one where you want the last day)
Use DateSerial to combine the month and the year, along with the day "1" to get the first day of the month in question.
Use DateAdd to add one month. This will get you the first day of the next month (which is one day after the date you really want).
Use DateAdd again to subtract (move back) one day. This will give you the last day of the month where you started.
Function eom(ByVal input_date As Date) As Date
' take the first day of the month from the input date, add one month,
' then back up one day
eom = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(input_date), Month(input_date), 1)))
End Function
In Access VBA, you can call Excel's EOMonth worksheet function (or almost any of Excel's worksheet methods) is by binding to an Excel application object and a WorksheetFunction object, which can be accomplished in a few ways.
Calling Excel functions with an Late Bound object
The shortest method from Access VBA is with a single line of code using a late-bound object. This example returns the date of the last day of the current month:
MsgBox CreateObject("Excel.Application").WorksheetFunction.EOMonth(Now(), 0)
A more verbose method, as a function:
Function eoMonth_LateBound(dt As Date) As Date
Dim xl As Object
Set xl = CreateObject("Excel.Application")
eoMonth_LateBound = xl.WorksheetFunction.eomonth(dt, 0)
Set xl = Nothing
End Function
An issue with late-bound references is that VBA takes a second to bind the object each time the function is called. This can be avoided by using early binding.
Calling Excel functions with an Early Bound object
If the function is to be used repeatedly, it's more efficient to go with Early Binding and retain the object between calls, for example:
Go Tools > References and add a reference to "Microsoft Excel x.xx Object Library" (use whatever the newest version number is that you have installed).
Add this code in a new module:
Option Compare Database
Option Explicit
Dim xl As Excel.Application
Function eoMonth_EarlyBound(dt As Date) As Date
If xl Is Nothing Then Set xl = New Excel.Application
eoMonth_EarlyBound = xl.WorksheetFunction.eomonth(dt, 0)
End Function
Sub demo()
MsgBox eoMonth_EarlyBound(Now())
MsgBox eoMonth_EarlyBound("4/20/2001")
End Sub
Creating a WorksheetFunction object
If Excel's worksheet functions are to be used lots throughout your code, you could even create a WorksheetFunction object to simplify the calls. For example, this could be a simple way to join multiple strings with TEXTJOIN, or get a response from an API with WEBSERVICE:
Sub Examples()
'requires reference: "Microsoft Excel x.xx Object Library"
Dim xl As Excel.Application, wsf As Excel.WorksheetFunction
Set xl = New Excel.Application
Set wsf = xl.WorksheetFunction
'use EOMONTH to return last date of current month
Debug.Print CDate(wsf.eomonth(Now(), 0))
'use WEBSERVICE return your current IP address from a free JSON API
Debug.Print wsf.WebService("https://api.ipify.org")
'use TEXTJOIN to implode a bunch of values
Debug.Print wsf.TextJoin(" & ", True, "join", "this", , "and", , "that", "too")
'always tidy up your mess when finished playing with objects!
Set wsf = Nothing
Set xl = Nothing
End Sub
Note that these functions may require Excel 2016+ or Excel 365 (aka: Object Library 16.0+.)
Another method I used was:
nMonth = 2
nYear = 2021
lastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)

Excel VBA yearfrac with mins and maxes

I'm trying to find the number of weeks between two dates in Excel VBA (with some min/max functionality in between), was getting Type Mismatch error (Run-time error '13') for the following line:
WeeksWorked = Application.WorksheetFunction.RoundDown _
(52 * Application.WorksheetFunction.YearFrac _
(Application.WorksheetFunction.Max(DOH, DateValue("Jan 1, 2012")), _
DateValue("Dec 31, 2012")), 0)
Anyone have any direction as to what I'm doing wrong, it would be greatly appreciated!
Not sure why do you need to use this in VBA, here is something you can try.
In Excel:
Assuming Start Date is in A1, End Date is in A2, then A3,
=(NETWORKINGDAYS(A1,A2))/5
Now that is in the perspective of business days, thus giving 5 day week. If you need 7 day week with regular days,
=WEEKNUM(A3)-WEEKNUM(A2)
The function WEEKNUM() in the Analysis Toolpack addin calculates the correct week number for a given date, if you are in the U.S. The user defined function below will calculate the correct week number depending on the national language settings on your computer.
If you still need to use VBA try this: (as Tim pointed out DateDiff pretty handy.) Or you can even use Evaluate to trigger WEEKNUM.
Option Explicit
Function numWeeks(startDate As Date, endDate As Date)
numWeeks = DateDiff("ww", startDate, endDate)
End Function
Using Evaluate on WEEKNUM:
Function numWeeks(startDate As Range, endDate As Range)
Dim s As Integer, t As Integer
s = Application.Evaluate("=WEEKNUM(" & startDate.Address & ",1)")
t = Application.Evaluate("=WEEKNUM(" & endDate.Address & ",1)")
numWeeks = t - s
End Function
Reference for Excel VBA DataTime Functions
As suggested in the comments you could just do:
debug.print DateDiff("ww", DateValue("Jan 1, 2012"), DateValue("Dec 31, 2012"))
If for some reason you wanted to roll your own you could truncate the quotient of:
| day1 - day2 |
---------------
7
Example code:
Sub test_numWeeks_fn()
Call numWeeks(DateValue("Jan 1, 2012"), DateValue("Dec 31, 2012"))
End Sub
Function numWeeks(d1 As Date, d2 As Date)
Dim numDays As Long
numDays = Abs(d1 - d2)
numWeeks = Int(numDays / 7)
Debug.Print numWeeks
End Function
Result:
52
Try below code :
Sub example()
Dim dob As Date
dob = #7/31/1986#
Dim todaydt As Date
todaydt = Date
Dim numWeek As Long
numWeek = DateDiff("ww", dob, todaydt) ' Difference in weeks
End Sub

Dates in For Loop in vb.net

In vb.net I have two data values as shown below:
Dim startp as datetime
Dim endp as datetime
I have a function called ProcessData(soemdate) which processes dataporting.
In VB.net is there a way I can do something like
For each day between startp and endp
ProcessData(soemdate)
Next
Thanks
Here is another way to do this.
Dim startP As DateTime = New DateTime(2009, 1, 1)
Dim endP As DateTime = New DateTime(2009, 2, 1)
Dim CurrD As DateTime = startP
While (CurrD <= endP)
ProcessData(CurrD)
Console.WriteLine(CurrD.ToShortDateString)
CurrD = CurrD.AddDays(1)
End While
For Each Day As DateTime in Enumerable.Range(0, (endp - startp).Days) _
.Select(Function(i) startp.AddDays(i))
ProcessData(Day)
Next Day
Adding to Joel Coehoorn's answer which I personally think should be the accepted answer as I always try to avoid While loops no matter how safe they may appear. For...Each is a much safer approach although the enumerable isn't very pretty in-line. You can however move it to a function to keep things more readable, plus you can re-use as needed.
For Each Day As DateTime In DateRange(StartDate, EndDate)
ProcessData(Day)
Console.WriteLine(Day.ToShortDateString)
Next
Public Shared Function DateRange(Start As DateTime, Thru As DateTime) As IEnumerable(Of Date)
Return Enumerable.Range(0, (Thru.Date - Start.Date).Days + 1).Select(Function(i) Start.AddDays(i))
End Function
I also added 1 to Enumerable range since as Joel had it, it wouldn't return the end date and in my situation I needed it to return all dates in the range including the start and end days.
Enumerable.Range is a sort of loop in itself that adds i days to the startdate advancing i with each call from in this case 0 to the difference between start and end days + 1. So the first time it's called you get the result of Start.AddDays(0), next you'll get Start.AddDays(1) and so on until the range is complete.
You can easily loop through each day if you convert your dates to OLE Automation Date OADate where the left portion represents the day and the right portion represents the time.
For example #06/19/2018#.ToOADate converts to 43270.0
For loopDate As Double = #06/19/2018#.ToOADate To #07/01/2018#.ToOADate
Dim thisDate As Date = DateTime.FromOADate(loopDate)
' Do your stuff here e.g. ProcessData(thisDate)
Next
Yes, you can use an accumulator date:
Dim Accumulator as DateTime
Accumulator = startp
While (Accumulator <= endp)
Accumulator = Accumulator.AddDays(1)
End While
Not tested, and I'm a C# programmer, so be easy if my syntax is wrong.
For those that come looking later, I had to add a +1 to the Range endpoint to get this to work for when the start and end were the same. Here is the code I used.
For Each Day As DateTime in Enumerable.Range(0, (endp - startp).Days + 1) .Select(Function(i) startp.AddDays(i))
'Do work here
Next Day
Set a calendar table with all dates and query values from there.
SQL:
Select Date as MyDate from tblCalendar Where Date >= StartDt And Date <= EndDate
.NET:
While Reader.read
process(MyDate)
End While