Excel VBA yearfrac with mins and maxes - vba

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

Related

VBA - Date Format "mm/dd/yyyy"

My excel file format for date is Mar 30 2016 10:12:27:396AM i want to change the format to mm/dd/yyyy. but i'm having an error on my code..
Run-time error '13': Type mismatch
this is the line i got the error SecondDate = Trim(Sheet2.Range("B" & RowNo).Value)
Note: The data from Column A and B are dates
My Code:
Dim Result, RowNo As Long
Dim FirstDate As Variant
Dim SecondDate As Variant
RowNo = 2
FirstDate = Trim(Sheet2.Range("A" & RowNo).Value)
SecondDate = Trim(Sheet2.Range("B" & RowNo).Value)
FirstDate = Format(FirstDate, "mm/dd/yyyy")
SecondDate = Format(SecondDate, "mm/dd/yyyy")
Do Until Sheet2.Cells(RowNo, 1) = ""
FirstDate = Sheet2.Cells(RowNo, 1)
SecondDate = Sheet2.Cells(RowNo, 2)
If DateDiff("d", FirstDate, SecondDate) >= 15 Then
Sheet2.Cells(RowNo, 3) = "1"
Sheet2.Cells(RowNo, 4) = "2"
End If
RowNo = RowNo + 1
Loop
i do feel like im in the right path..am i missing something?
Update: My script will get the data from Column A and Column B and using the DateDiff function i will subtract both columns if the difference is <15 tag it from Column C and D as 1, 2
note:
i only subtract the days from both columns.. but is it possible to subtract both days and years?
it's working if i use the format mm/dd/yyyy in the excel but if i use other format i got the error mismatch
Updated 2:
Column A | Column B | Column C
Mar 1 2016 10:12:27:396AM | Mar 30 2016 10:12:27:396AM |
Mar 1 2016 10:12:27:396AM | Mar 30 2016 10:12:27:396AM |
in my file this is the date format, if you try this as sample data it won't work maybe because VBA doesnt recognize this as dateformat?
Perhaps this will address what you are trying to do.
Test Input:
Test Output:
Code:
Sub DateStuff()
Dim FirstDate As Range, SecondDate As Range
Dim RowNo As Long
Set FirstDate = Sheet4.Range("A1")
Set SecondDate = Sheet4.Range("A2")
FirstDate.NumberFormat = "mm/dd/yyyy"
SecondDate.NumberFormat = "mm/dd/yyyy"
RowNo = 2
Do Until Sheet4.Cells(RowNo, 1) = ""
Set FirstDate = Sheet4.Cells(RowNo, 1)
Set SecondDate = Sheet4.Cells(RowNo, 2)
If IsDate(FirstDate.Value) And IsDate(SecondDate.Value) Then
If DateDiff("d", FirstDate, SecondDate) >= 15 Then
Sheet4.Cells(RowNo, 3) = 1
Sheet4.Cells(RowNo, 4) = 2
End If
End If
RowNo = RowNo + 1
Loop
End Sub
Please spend a few minutes to understand this code:
FirstDate and SecondDate are Range data types, not Date or Variant. The data in the cells they point to are Date or something else.
When setting the format, it sets how it is displayed on the worksheet. It is not formatting a character string in VBA.
Before making the DateDiff call, ensure both FirstDate and SecondDate really contain Date datatypes in the cells, this will prevent many errors.
Operations on Date datatypes using Date functions are NOT dependent on formatting. They use the internal Date type. Formatting ONLY affects how a date is converted to a string and/or displayed on the worksheets.
You asked about checking year instead of day. There are built in VBA functions (e.g. Year, Month, etc.) that will help with this.
As to your update to your question:
I am not sure where you are getting your time codes from, but Excel does not recognize :000 for milliseconds. It uses .000. See below ...

ISO week number in VBScript or VBA

How can I get the ISO week number of some date in VBScript or VBA?
First, note that:
It is important to report the week year along with the week number, as the date's year could be different.
Several Windows components contain a bug for some years' last Monday.
In my experience the simplest, clearest and most robust way to compute this is:
Sub WeekNum(someDate, isoWeekYear, isoWeekNumber, isoWeekDay)
Dim nearestThursday
isoWeekDay = WeekDay(someDate, vbMonday)
nearestThursday = DateAdd("d", 4 - Int(isoWeekDay), someDate)
isoWeekYear = Year(nearestThursday)
isoWeekNumber = Int((nearestThursday - DateSerial(isoWeekYear, 1, 1)) / 7) + 1
End Sub
This also returns the ISO day of the week, counting from 1 for Mondays.
Enter any date into A1 cell, then run following code...
Range("A2").FormulaR1C1 = "=INT((R1C-DATE(YEAR(R1C-WEEKDAY(R1C-1)+4),1,3)+WEEKDAY(DATE(YEAR(R1C-WEEKDAY(R1C-1)+4),1,3))+5)/7)"
You can get it via DatePart() VBA function:
Sub IsoWeek()
Dim isoWeekNum As Byte
Dim myDate As Date
myDate = DateValue("01-01-2022")
isoWeekNum = DatePart("ww", myDate, vbMonday, vbFirstFourDays)
If isoWeekNum > 52 Then ' Bug check (to avoid the bug with Mondays)
If Format(myDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then isoWeekNum = 1
End If
Debug.Print isoWeekNum
End Sub

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 Adding 1 hour to a date / time string

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

VBA Incrementing Date Error

I've never done VBA before but a friend has asked for help so I've been working on his project. I'm trying to increment a given date by one day but I'm getting an "Object Required" error in the DateAdd function. As far as I can tell I'm putting in an object (firstDate)...
The date entered,for my testing purposes at least, has been 12/03/2012 in that format.
The Format and CDate functions seem to work fine and parse the date.
Here's the code, I get the error at the line with DateAdd in it.
Sub GetDate()
Dim strDate As String
strDate = InputBox(Prompt:="Enter the first day of the week in dd/mm/yyyy format.", _
title:="First day of the week", Default:="")
If strDate = "" Or strDate = vbNullString Then
Exit Sub
Else
Dim firstDate As Date
firstDate = CDate(Format(strDate, "Short Date"))
'Add to O and 6 after
For inc = 0 To 6 Step 1
Range(Chr(79 + inc) & 1) = firstDate
firstDate = DateAdd(DateInterval.Day, 1, firstDate)
Next
End If
End Sub
Appreciate any help.
You're just trying to increment by one day, right?
firstDate = firstDate + 1
The unit of the Date type is one day. So adding 1 adds one day.
Very well...
DateAdd("d", 1, firstDate)
But: I'm not that fussed if anyone reposts a comment of mine as an answer. I do read the comments as well as the answers. Maybe because I have this habit of suggesting answers in comments...