I have two strings with dates, I want to loop through the hours of the dates. I tried the following:
strStart = "15-01-2016 09:00"
strEnd = "16-01-2016 15:00"
j=0
for i = cdate(strStart) to cdate(strEnd)
msgbox(i)
j=j+1
next i
I also tried replacing cdate() in the for loop by timevalue(). At the end, I want my j to be 30. (15 hours of the first day and 15 of the second)
Use the DateAdd- and DateDiff-Functions for this:
dateStart = cDate(strStart)
dateEnd = cDate(strEnd)
j = 0
While DateDiff("h", dateStart, dateEnd) > 0
j=j+1
dateStart = DateAdd("h", 1, dateStart)
Wend
This way, you don't have to create a new Date for every loop, and you can easily access other date formats (days, minutes, years...)
Related
Global time As Date
Sub countdown()
time = Now()
time = DateAdd("s", 120, time)
Do Until time < Now()
DoEvents
oSh.TextFrame.TextRange = Format((time - Now()), "ss")
Loop
End Sub
The timer starts from 60 and ends at 00. Then the same repeats. Is it possible to start the timer from 120 directly? How can we go about it?
Use DateDiff:
Global StopTime As Date
Sub countdown()
StopTime = DateAdd("s", 120, Now)
Do Until StopTime < Now
DoEvents
oSh.TextFrame.TextRange = DateDiff("s", Now, StopTime)
Loop
End Sub
Format will simply read the seconds from a date value, there is no way to "force" it to calculate the total seconds. However, it is rather easy to calculate it manually:
Dim delta as Date
delta = t - now
oSh.TextFrame.TextRange = Minute(d) * 60 + Second(d)
' or, if you want to have always 3 digits, eg 030
oSh.TextFrame.TextRange = Format(Minute(d) * 60 + Second(d), "000")
Working on populating a row in excel with dates between a start date and current date. The population is weekly and below is the function I have made. It works fine up until the point where it doesn't stop but continues to go infinitely until there is an overflow error hence my assumption is that CurrentDate is not working properly.
The 2 dates used are StartDate = 04/1/2016 and CurrentDate = 12/07/2017.
Any help or suggestions would be greatly appreciated.
Public Function PopulateStartOfWeekDates()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim StartDate As Date
Dim CurrentDate As Date
StartDate = FirstMondayOfYear()
CurrentDate = Date
Dim WeekOffset As Integer
Dim i As Integer
i = 12
WeekOffset = 0
Debug.Print StartDate
Debug.Print CurrentDate
Do While StartDate < CurrentDate
wsCRC.Cells(5, i) = StartDate + WeekOffset
wsCRC.Cells(5, i).EntireColumn.AutoFit
i = i + 1
WeekOffset = WeekOffset + 7
Loop
End Function
If you decide you need to maintain the value of StartDate (e.g. to use later in the code), you could replace your loop with:
i = 0
Do While StartDate + i * 7 < CurrentDate
wsCRC.Cells(5, i + 12) = StartDate + i * 7
wsCRC.Cells(5, i + 12).EntireColumn.AutoFit
i = i + 1
Loop
After looking at this myself I realized I wasn't increasing the startdate hence the loop was infinite. Thanks to #Nathan_Sav for pointing this out in the comments too.
I have data in my excel sheet that can be reproduced by this function:
sub dummy_data
start_date = Sheets("Blad1").Cells(2, 4) = "20-03-2014"
end_date = Sheets("Blad1").Cells(3, 4) = 20-04-2014"
End sub
Now I would like to create a list of all weeks between these dates. Therefore I did:
Sub print_dates
start_date = Sheets("Blad1").Cells(2, 4)
end_date = Sheets("Blad1").Cells(3, 4)
'Get number of weeks
r = (end_date - start_date) / 7
r = Round(r)
new_date = start_date
counter = 0
While (new_date < (end_date - 7))
For i = 1 To r
counter = counter + 7
new_date = start_date + counter
'print date
Sheets("Blad1").Cells(i, 4).FormulaLocal = new_date
Next i
Wend
End sub
This works a little however but it gives me always one row too much. So if I
enter start_date = 23-3-2013 and end_date 04-04-2013 I get one value after 04-04-2013.
Any thoughts on how I can an overview with only the weeks between a certain range?
The problem is the For Loop inside the While Loop.
That said, I just tested this code and it worked and is simpler.
Sub print_dates()
start_date = Sheets("Blad1").Cells(2, 4)
end_date = Sheets("Blad1").Cells(3, 4)
new_date = start_date
i = 1
While (new_date < (end_date - 7))
new_date = new_date + 7
'print date
Sheets("Blad1").Cells(i, 5).FormulaLocal = new_date
i = i + 1
Wend
End Sub
try the following code:
Sub print_dates()
start_date = Sheets("Blad1").Cells(2, 4)
end_date = Sheets("Blad1").Cells(3, 4)
'Get number of weeks
r = (end_date - start_date) / 7
r = Round(r)
new_date = start_date
counter = 0
For i = 1 To r
If new_date + 7 <= end_date Then
counter = counter + 7
new_date = start_date + counter
'print date
Sheets("Blad1").Cells(i, 5).FormulaLocal = new_date
End If
Next i
End Sub
Try using datediff to determine how many weeks. Just easier.
MSDN has a really good datediff function tutorial here
R = DateDiff("w", startdate, enddate) ' Determine week difference between two dates.
Also, I suspect the extra week is being added because the code makes sunday the first day of the week, not monday. So you would have to also take in account the days between currentday and vbsunday. Or just put that in the datediff function like this.
R = DateDiff("w", startdate, enddate, vbmonday or whatever current day.)
I currently have a spreadsheet with pre written dates in order in a dd/mm/yyyy format, but i want to be able to change the entire sheet so that when i select a month from a drop down list it changes all the dates so they stay starting at the 1st through to the 31st, but only the month changes, using visual basic. I can use this to set specific dates,
Range("C3") = Format(DateSerial(Year:=2005, Month:=2, Day:=3), "mm-dd-yyyy")
But can i change just the month using something like this for example
Range("C3") = Format(DateSerial(Month:=5), "mm-dd-yyyy")
You could do something like this:
Function MakeDates(startDate As Date) As Date()
Dim myDates() As Date, myYear As Integer, myMonth As Integer, daysInMonth As Integer
Dim firstOfMonth As Date, firstOfNextMonth As Date, d As Integer
myYear = Year(startDate)
myMonth = Month(startDate)
firstOfMonth = DateSerial(myYear, myMonth, 1)
firstOfNextMonth = DateSerial(myYear, myMonth + 1, 1)
daysInMonth = DateDiff("d", firstOfMonth, firstOfNextMonth)
ReDim myDates(daysInMonth - 1)
For d = 1 To daysInMonth
myDates(d - 1) = DateSerial(myYear, myMonth, d)
Next d
MakeDates = myDates
End Function
Then you can call it like this
Dim d
d = MakeDates(#2/1/2014#)
Range("A1").Resize(rowsize:=31).Value = ""
Range("A1").Resize(rowsize:=UBound(d) + 1) = WorksheetFunction.Transpose(d)
That second to last line will remove the excess dates for you.
You should have your range formatted as a date. You can do that in code or just do it once in Excel. The latter is probably easier.
If i have a string containing a date formatted like this:
1402-3
which means Year: 2014, Week: 02 and Day number 3 (monday is 1), how can i convert this to a normal date? (in this case the date above is today; 2014-01-08 - wednesday 8 jan 2014)
Edit: I came up with a function like this, can anyone tell if this is gonna fail or maybe have a better and better coded function/solution?
Private Function StrangeFormattedDateToRegularDate(ByVal StrangeDate As String) As Date
Dim Y As String = "20" & StrangeDate.Substring(0, 2) 'I'll be dead before this fails, haters gonna hate
Dim W As String = StrangeDate.Substring(2, 2)
Dim D As String = StrangeDate.Substring(5, 1)
'Get first day of this year
Dim RefDate As Date = New Date(CInt(Y), 1, 1)
'Get the first day of this week (can be the year before)
Dim daysOffSet As Integer = DayOfWeek.Monday - RefDate.DayOfWeek
RefDate = RefDate.AddDays(daysOffSet)
'Add as many days as the weeks is
RefDate = RefDate.AddDays(7 * CInt(W))
'now the date is the last day of this week (plus one day), remove the days that are ahead, and remove that extra day
Dim daysToRemove = ((7 - CInt(D)) * -1) - 1
RefDate = RefDate.AddDays(daysToRemove)
Return RefDate
End Function
This should be what you're looking for :) This looked challenging so I tried it. Tell me if it works for you or not :)
Function GetDate(InputDate As String) As DateTime
Dim FirstDayofYear As Date = CType("1/1/20" & Mid(InputDate, 1, 2), Date)
Dim LastDayofYear As Date = CType("12/31/20" & Mid(InputDate, 1, 2), Date)
Dim target As Date
For x = 0 To DateDiff(DateInterval.Day, FirstDayofYear, LastDayofYear)
Dim dfi = DateTimeFormatInfo.CurrentInfo
Dim calendar = dfi.Calendar
Dim weekOfyear = calendar.GetWeekOfYear(FirstDayofYear.AddDays(x), dfi.CalendarWeekRule, DayOfWeek.Sunday)
If CInt(Mid(InputDate, 3, 2)) = weekOfyear And CInt(Mid(InputDate, InStr(InputDate, "-") + 1)) = FirstDayofYear.AddDays(x).DayOfWeek Then
target = FirstDayofYear.AddDays(x)
GoTo skip
End If
Next x
skip:
Return target
End Function
This works up to Year 2099. We're probably all dead by then.