Read the correct week number from a calendar date - vba

I have below dates in an Excel column, as you can see.
Sprint 1 takes from 10.04 to 21.04 this means 2 weeks and between brackets they are specified week 15 and 16 which is correct but for Sprint 2, who also starts in 10.04 but takes until 05.05 it means 7 weeks, but are displayed also the weeks from the Sprint1.
"Sprint1 (CW15-16/2017)
[10.04.2017 - 21.04.2017]
Sprint2 (CW15-16/2017)
[10.04.2017 - 05.05.2017]"
What I have until now is:
'reading the first CW of the sprint based on the date
SprintFristCW = Left(planning_wb.Worksheets(SprintPlanningTable).Cells(2, i + 1).Value, 9)
'reading the last CW of the Sprint based on the date
SprintEndCW = Right(planning_wb.Worksheets(SprintPlanningTable).Cells(2, i + Sprintlength).Value, 9)
SprintCW = Left(SprintFirstCW, 4) & "-" & Right(SprintEndCW, 7)
But SprintEndCW is not reading correct the week number.
So I need to read the correct week number in which each sprint ends and print it.

Don't create huge procedures. Small is beautiful. Create functions that feed into your Main procedure. Here is an example. The procedure TestExtraction calls the function ExtractWeeks. Therefore ExtractWeeks needs not be part of the procedure that calls it, making the code easier to understand and maintain.
Private Sub TestExtraction()
Dim Fun As Long
Dim DateString As String
Dim StartDate As Date, EndDate As Date
DateString = ActiveCell.Value
' the DateString is re-defined here for testing purposes
DateString = "[10.04.2017 - 05.05.2017]"
Fun = ExtractWeeks(DateString, StartDate, EndDate)
If Fun < 0 Then
Debug.Print "Invalid date"
Else
With Application
DateString = "(CW" & .WeekNum(StartDate)
If Year(StartDate) <> Year(EndDate) Then _
DateString = DateString & "/" & Year(StartDate)
DateString = DateString & " - " & .WeekNum(EndDate) & "/" & Year(EndDate) & ")"
End With
Debug.Print DateString
Debug.Print Fun & " weeks"
End If
End Sub
Private Function ExtractWeeks(ByVal DateString As String, _
StartDate As Date, _
EndDate As Date) As Long
' 24 Oct 2017
' return the number of weeks between dates (rounded up)
' return -1 if one of the dates is unreadable
Dim Dates() As String
Dim i As Integer
Dates = Split(Mid(DateString, 2, Len(DateString) - 2), "-")
On Error Resume Next
For i = 0 To 1
Dates(i) = Replace(Trim(Dates(i)), ".", Application.International(xlDateSeparator))
Next i
StartDate = DateValue(Dates(0))
EndDate = DateValue(Dates(1))
If Err Then
ExtractWeeks = -1
Else
ExtractWeeks = Int((StartDate - EndDate) / 7) * -1
End If
End Function
The point is that not everything that looks like a date is a date Excel can understand. The Function ExtractWeeks converts the "dates' from your worksheet into real dates and returns these dates to the calling procedure. It also returns -1 in case of error which you can use to trap such errors. In my example, the function returns the number of weeks (or -1). You might let it return the CW string my calling procedure constructs. You will find it easy to move the process of constructing that string to the function and let the function return "" in case of error instead of -1. Perhaps you can exclude the possibility of errors in the dates. This is a question of how you integrate the function into your Main.

Related

VBA code to generate accurate elapsed number of months & days between two dates

I am trying to develop VBA code that yields the accurate number of months and remaining days between two dates.
The test dates to be used are the following:
Date1: 04/19/1995
Date2: 12/26/22
The correct answer per: https://www.calculator.net/date-calculator.html is: 332 months 7 days
The correct answer generated per my VBA code below is: 332 months 3 days.
Can anyone shed some light as to why this is the case?
Private Sub CommandButton7_Click()
' Calculate the difference between two dates in months and remaining days
Dim startDate As Date
Dim endDate As Date
Dim months As Long
Dim days As Long
startDate = Application.InputBox("Enter a date:", "Date Input 1", Date, Type:=2)
endDate = Application.InputBox("Enter another date:", "Date Input 2", Date, Type:=2)
months = Abs(DateDiff("m", startDate, endDate))
days = Abs(DateDiff("d", startDate, endDate)) Mod 30
MsgBox "The difference between the two dates is: " & months & " months and " & days & " days."
End Sub
Yes. The following line in your code -
days = Abs(DateDiff("d", startDate, endDate)) Mod 30
assumes that all months have 30 days. They do not!
It is not that simple because of the varying count of days of the months. You have to use DateAdd to obtain the correct month count.
This function does it right:
' Returns the difference in full months from DateOfBirth to current date,
' optionally to another date.
' Returns by reference the difference in days.
' Returns zero if AnotherDate is earlier than DateOfBirth.
'
' Calculates correctly for:
' leap Months
' dates of 29. February
' date/time values with embedded time values
' any date/time value of data type Date
'
' DateAdd() is, when adding a count of months to dates of 31th (29th),
' used for check for month end as it correctly returns the 30th (28th)
' when the resulting month has 30 or less days.
'
' 2015-11-24. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function AgeMonthsDays( _
ByVal DateOfBirth As Date, _
Optional ByVal AnotherDate As Variant, _
Optional ByRef Days As Integer) _
As Long
Dim ThisDate As Date
Dim Months As Long
If IsDateExt(AnotherDate) Then
ThisDate = CDate(AnotherDate)
Else
ThisDate = Date
End If
' Find difference in calendar Months.
Months = DateDiff("m", DateOfBirth, ThisDate)
If Months < 0 Then
Months = 0
Else
If Months > 0 Then
' Decrease by 1 if current date is earlier than birthday of current year
' using DateDiff to ignore a time portion of DateOfBirth.
If DateDiff("d", ThisDate, DateAdd("m", Months, DateOfBirth)) > 0 Then
Months = Months - 1
End If
End If
' Find difference in days.
Days = DateDiff("d", DateAdd("m", Months, DateOfBirth), ThisDate)
End If
AgeMonthsDays = Months
End Function
Example (in the immidiate pane):
Days% = 0
? AgeMonthsDays(#04/19/1995#, #12/26/2022#, Days%), Days%
332 7
It is from my library at GitHub: VBA.Date.
Date Difference in Months and Days
The Button Code
Private Sub CommandButton7_Click()
DateDifference
End Sub
The Main Method
Sub DateDifference()
' Calculates the difference between two dates in months and days.
' Define constants.
Const PROC_TITLE As String = "Date Difference"
Dim Prompts(): Prompts = VBA.Array("Enter a date:", "Enter another date:")
Dim Titles(): Titles = VBA.Array("Date Input 1", "Date Input 2")
' Get the input using the 'GetInputDate' function.
Dim InputValue As Variant
Dim Dates(0 To 1) As Date
Dim d As Long
For d = 0 To 1
InputValue = GetInputDate(Prompts(d), Titles(d))
If IsEmpty(InputValue) Then Exit Sub
Dates(d) = CDate(InputValue)
Next d
' Determine the Start and End date ('Start <= End').
Dim StartDate As Date, EndDate As Date
If Dates(0) < Dates(1) Then
StartDate = Dates(0)
EndDate = Dates(1)
Else
StartDate = Dates(1)
EndDate = Dates(0)
End If
' Calculate the difference.
Dim Months As Long: Months = DateDiff("m", StartDate, EndDate)
Dim MonthDate As Date: MonthDate = DateAdd("m", Months, StartDate)
Dim Days As Long: Days = DateDiff("d", MonthDate, EndDate)
' Inform.
Dim Msg As String: Msg = "The difference between the two dates is " _
& IIf(Months = 1, "one month", Months & " months") & " and " _
& IIf(Days = 1, "one day", Days & " days") & "."
MsgBox Msg, vbInformation, PROC_TITLE
End Sub
A Helper Function
Function GetInputDate( _
ByVal Prompt As String, _
ByVal Title As String) _
As Variant ' a date or 'Empty'
Const PROC_TITLE As String = "Get Input Date"
Dim InputValue As Variant, MsgAnswer As Long, Msg As String
Do
InputValue = Application.InputBox(Prompt, Title, Date, , , , , 2)
If VarType(InputValue) = vbBoolean Then
MsgBox "Canceled.", vbExclamation, PROC_TITLE
Exit Function
End If
If IsDate(InputValue) Then GetInputDate = InputValue: Exit Function
Msg = "The string """ & InputValue & """ can't be converted " _
& "to a date. Do you want to try again?"
MsgAnswer = MsgBox(Msg, vbYesNo + vbQuestion, PROC_TITLE)
If MsgAnswer = vbNo Then Exit Function
Loop
End Function

Visual basic date object parsing from string with indexing

I would like to ask if in VBA there is a built in function which will parse a date object from a string based on a specified format.
For example:
dateString = "24-4-12"
VBADateFunc(dateString, "dd-m-yy")
to return a date object interpreting the dateString string by the provided format.
I will appretiate your ideas on this.
Thank you
Here you go:
Public Sub TestMe()
Dim dtMyDate As Date
dtMyDate = Format("24-4-12", "dd-mm-yy")
Debug.Print dtMyDate
Debug.Print Format(dtMyDate, "yyyy")
Debug.Print Format(dtMyDate, "dd-mmm-yy")
'For Non-Europeans:
dtMyDate = Format(DateSerial(2012, 4, 24), "dd-mm-yy")
Debug.Print dtMyDate
Debug.Print Format(dtMyDate, "yyyy")
Debug.Print Format(dtMyDate, "dd-mmm-yy")
End Sub
From the comments - in general, the date is a long value in MS Excel and VBA. Today's date can be seen like this in the immediate window:
?clng(now)
42935
If you want to do further something with the 42935 value, you may go like this:
?Format(42934,"dd-mm-yyyy")
Note: Today is 42934 for all those, who have ActiveWorkbook.Date1904 = False. For those, who are starting the calendar with 1904, today is 42935-4*365-1
I ended up writing my own function to scan a date. Leaving out error handling:
Function ScanDate(s As String, Optional order As String = "DMY", Optional separator As String = "-") As Date
Dim parts() As String
parts = Split(s, separator)
Dim day As Long, month As Long, year As Long
day = parts(InStr(order, "D") - 1)
month = parts(InStr(order, "M") - 1)
year = parts(InStr(order, "Y") - 1)
ScanDate = DateSerial(year, month, day)
End Function

VBA - Checking date string validity

I have a string in the following format in Excel.
07/12/2015 08:00 - 08/12/2015 09:00
I want to check if the current date fits between the two (these dates are validity dates, meaning I have to check if the current date is bigger than the first date and smaller than the second date).
I sometimes also have this string without hours, so like:
07/12/2015 - 08/12/2015
so I have to check that as well (just without the hours).
I split the dates using the Split function to split by the "-" character. However, I'm not sure how to do the check because I've never worked with dates.
Can anyone show me how to do this? It seems that it'd be complicated with the check for the hours.
You can try this :
Dim mydate as String, splitdate as Variant
mydate = "07/12/2015 08:00 - 08/12/2015 09:00"
splitdate = Split(mydate, "-")
If Date < splitdate(0) And Date > splitdate(1) Then MsgBox "Is Between"
In case there will be some issues with understanding date formats, you can still use Cdate function -
If Date < CDate(splitdate(0)) ...
Assuming, that you String is located in A1, and the Date you want to check for is in B1, then put this formula in C1:
=IF(AND(B1>=DATEVALUE(LEFT(A1,10)),B1<=DATEVALUE(MID(A1,FIND("-",A1)+2,10))),TRUE,FALSE)
This works for both cases, if you are only interested if the date lies between the dates (thus excluding the time).
Use cdate function. You wrote you already used the split function, so all you need to do is put the separate date strings into date variables using cdate ('c' stands for cast).
So
Dim d1 as Date
Dim d2 as Date
d1 = CDate(splitstring(0))
d2 = CDate(splitstring(1))
Then you can check the given date.
With the CDate() conversion function and Trim (to get rid of useless spaces), here is a boolean function that you can easily use to test if you are in the time lapse described by your string.
Here is how to use it :
Sub test_Gilbert_Williams()
Dim TpStr As String
TpStr = "08/12/2015 08:00 - 08/12/2015 09:00"
'TpStr = "07/12/2015 - 08/12/2015"
MsgBox Test_Now_Date_Validity(TpStr)
End Sub
And the function :
Public Function Test_Now_Date_Validity(Date_Lapse As String) As Boolean
Dim A() As String, _
Date1 As Date, _
Date2 As Date
If InStr(1, Date_Lapse, "-") Then
A = Split(Date_Lapse, "-")
Debug.Print Trim(A(0)) & " " & CDate(Trim(A(0)))
Debug.Print Trim(A(1)) & " " & CDate(Trim(A(1)))
If CDate(A(0)) > CDate(A(1)) Then
Date1 = CDate(A(1))
Date2 = CDate(A(0))
Else
Date1 = CDate(A(0))
Date2 = CDate(A(1))
End If
If Now > Date1 And Now < Date2 Then
Test_Now_Date_Validity = True
Else
Test_Now_Date_Validity = False
End If
Else
Exit Function
End If
End Function

How can I convert a long date with time to a different format in VBA?

I have data for a date that looks like this: "2015-02-11T19:41:50-08:00"
I would like to know if there is already a function that exists in VBA which can convert the above data to the format of something like "02/11/2015 11:41 AM PST"
I attempted the following code playing around with the format function but was unable to get VBA to recognize the format as a date:
testdate = "2015-02-12T22:57:05-08:00"
newdate = Format(testdate, "mm/dd/yyyy hh/nn/ss AM/PM")
Debug.Print newdate
The output was still "2015-02-12T22:57:05-08:00"
Thanks for the help.
Edit:
I was able to resolve the problem by taking your suggestions to use the mid() function since the dates are in fixed format. I decided to keep the military time in the final version.
Here is my code for anyone curious:
Function convertDate(orderdate)
'takes the date formatted as 2015-02-06T08:26:00-08:00
'and converts it to mm/dd/yyyy hh/nn/ss UTC format
'2015-02-06T08:26:00-08:00
orderyear = Mid(orderdate, 1, 4)
ordermonth = Mid(orderdate, 6, 2)
orderday = Mid(orderdate, 9, 2)
orderhour = Mid(orderdate, 12, 2)
orderminute = Mid(orderdate, 15, 2)
ordersecond = Mid(orderdate, 18, 2)
newdate = ordermonth & "/" & orderday & "/" & orderyear
newtime = orderhour & ":" & orderminute & ":" & ordersecond
'Debug.Print newdate
convertDate = newdate & " " & newtime & " UTC"
End Function
Because your input isn't a true date none of Excel or VBA's date methods will work with it. Your best bet is to break the string down into parts, work with them individually, and then join it all back up again - for example:
testdate = "2015-02-12T22:57:05-08:00"
'// The letter T is redundant, so let's split the string here into an array:
dateArr = Split(testdate, "T")
'// Part 1 of the array can be easily converted with CDate() and Format()
dateArr(0) = Format(CDate(dateArr(0)), "mm/dd/yyyy")
'// Part 2 of the array will need to be broken down further:
dateArr(1) = Format(TimeValue(Split(dateArr(1), "-")(0)) - _
TimeSerial(Left(Split(dateArr(1), "-")(1), 2), _
Right(Split(dateArr(1), "-")(1), 2), 0), "hh:mm:ss")
'// The above line does the following:
'// 1) Split the second part of the array again, using the "-" as the delimiter
'// 2) Convert the first part of this (22:57:05) to a time using TimeValue()
'// 3) Convert the second part (08:00) to hours & minutes using TimeSerial()
'// 4) Minus the latter from the former (which can only be done if both are a valid time)
'// 5) Wrap all that into a Format() method to show "hh:mm:ss" instead of a Double.
'// Join the two parts back together and add "PST" on the end.
newdate = Join(dateArr, " ") & " PST"
Debug.Print newdate
'// Output will display "02/12/2015 14:57:05 PST"
N.B. I have chosen not to include "AM" or "PM" because your time is in 24hr format anyway so I don't see the relevance...
It's not converting because of the "T" and because of the tacked on time range at the end. You can ditch the "T" and truncate off the trailing range and it will convert.
Public Sub Example()
Const testValue As String = "2015-02-12T22:57:05-08:00"
Dim dateValue As Date
Dim stringValue As String
Dim subVal As Date
Dim hyphenPos As Long
stringValue = testValue
Mid(stringValue, 11&, 1&) = " "
hyphenPos = InStrRev(stringValue, "-")
subVal = Mid$(stringValue, hyphenPos + 1&)
dateValue = CDate(Left$(stringValue, hyphenPos - 1&)) - subVal
End Sub
Couple of ideas:
The sample date you have 2015-02-12T22:57:05-08:00 is not a real date (I think)
I think the following will give you the closest format to what you are looking for (you will need to define the range.Range.NumberFormat = "[$-409]h:mm:ss AM/PM"
Your best bet is concating "PST" to a date datatype formatted to your needs.
Sub DebugPrintDate()
Dim testdate As Date: testdate = Now
newdate = Format(testdate, "mmm/dd/yyyy hh:mm AM/PM") & " PST"
Debug.Print newdate
End Sub
Ouput:
Never mind the "févr". My system locale is France.
If you want to define a particular date, make sure to wrap the date in two #s.
Example:
Dim someDateAndTime As Date = #8/13/2002 12:14 PM#

Month function throwing type mismatch on example code from VBA help-file

I checked here and all over the web and found a few solutions to this that I tried, including casting Now as a CDate, but nothing works.
Using the VBA Editor w/ Excel 2010 on Win7.
Even the example code from the help section is throwing this error and the date used in the Month() function is explicitely initialized in numeric form.
In both cases I tried using CDate() on the month() argument, it does not work. In my original code I also tried using Date instead of Now, no effect either.
Here is my original code, which casts the error on the If condition:
Function SetNextTaskNb()
Dim seqNb As String
seqNb = ThisWorkbook.Worksheets("Persistent").Range("A" & 1).Value
Dim Nbs() As String
Nbs = Split(seqNb, ".", 2)
Dim month, currentNb, nextNb As Integer
month = CInt(Nbs(0))
currentNb = CInt(Nbs(1))
If month(Now) = month Then
nextNb = currentNb + 1
Else
nextNb = 1
End If
ThisWorkbook.Worksheets("Persistent").Range("A" & 1).Value = currentMonth + "." + nextNb
ThisWorkbook.Worksheets("Sheet1").Range("A" & 1).Value = currentMonth + "." + nextNb
End Function
Here is the example code from the VBA Editor Help section, which, copy-pasted with no modifications throws the same error on the first Debug.Print. It won't even display it.
Dim MyDate, MyMonth
MyDate = #2/12/1969# ' Assign a date.
Debug.Print "month is " & month(MyDate)
Debug.Print "rgMonth.Cells(i, j).Value is " & rgMonth.Cells(i, j).Value
MyMonth = month(CDate(MyDate)) ' MyMonth contains 2.
I know I'm supposed to give the Month() function a date in numeric form, and that it returns an Integer. I tried everything I could think of.
Here is proof this is the code from the Help:
you are using Month as both the name of a function and the name of a variable................give the variable a different name.