I need to make a form in Excel that asks for a start and end date. Then, I need to write a VBA script that writes out each day within that range in the first blank cell in column A.
So, for example, if it was given:
Start Date: 1/5/2017
End Date: 1/9/2017
The Result would be:
1/5/2017
1/6/2017
1/7/2017
1/8/2017
1/9/2017
Then if it is run again with a new date range, the dates would append to the bottom of the list. This is just a short example, in practice the date ranges would be much larger and consist of several months.
I'm not really sure where to begin with this, so any help would be greatly appreciated!
As #Ron Rosenfeld mentioned, a date in VBA is only a number that can be increased or decreased with simple numeric operations. This code should do exactly what you want:
Dim startDate As Date
Dim endDate As Date
startDate = DateSerial(2017, 1, 1)
endDate = DateSerial(2017, 1, 23)
Dim sheet As Worksheet
Set sheet = Worksheets("Table1")
Dim i As Integer
i = 1
While startDate <= endDate
sheet.Cells(i, 1) = startDate
startDate = startDate + 1
i = i + 1
Wend
Related
I currently have a spreadsheet that has the dates (excluding weekends and holidays) for the past 10 years in column A. For example, A1 contains "7/19/2007" and A2520 contains "7/19/2017"
Column E contains the closing price for the stock SPY on those corresponding dates.
I am trying to figure out the standard deviation for the past 5 years. In order to do so, my idea was to write a VBA code that would select today's date and the previous five years, and then use that to calculate the standard deviation.
This list is updated everyday, meaning tomorrow, it will contain 7/20/2017 and the closing price for that day. My issue is that I cannot figure out how to make it so it will select today's date and the past five years, so then I can calculate the standard deviation.
Thank you guys for all your help! Sorry if this seems simple, I have just started learning VBA last week!
How's this? I make a few assumptions, like your dates are contiguous, and there's no empty cell in your Date column. I also assume your dates are in order, ascending. (So your day 10 years ago is in say row 10, and today is in row 1000).
Sub get_difference()
Dim dateRng As Range, cel As Range, priceRng As Range
Dim dateCol As Long, stockCol As Long, lastDate As Range
Dim tdyDate As Date, decadeAgo As Date
dateCol = 1 ' column A has your dates
stockCol = 5
tdyDate = WorksheetFunction.Text(Now(), "mm/dd/yyyy")
decadeAgo = get_Previous_Date(tdyDate)
Debug.Print decadeAgo
With Sheets("Stock Prices") ' change name as necessary
With .Columns(dateCol)
Set lastDate = .Find(what:=tdyDate) ' Assuming no break in data from A1
'lastDate.Select
Set cel = .Find(what:=decadeAgo)
'cel.Select
End With
Set rng = .Range(.Cells(cel.Row, dateCol), .Cells(lastDate.Row, dateCol))
'rng.Select
Set priceRng = rng.Offset(0, stockCol - dateCol)
'priceRng.Select
'priceRng.Offset(0, 1).Select
priceRng.Offset(0, 1).FormulaR1C1 = "=IFERROR((RC[-1]/R[-1]C[-1])-1,"""")"
End With
End Sub
Function get_Previous_Date(Dt As Date) As Date
' https://www.mrexcel.com/forum/excel-questions/37667-how-subtract-year-date-2.html
Dim numYearsBefore as Long, numDaysBefore as Long, numMonthsBefore as Long
numYearsBefore = 10 ' Change this to any amount of years
numDaysBefore = 0
numMonthsBefore = 0
get_Previous_Date = DateSerial(Year(Dt) - numYearsBefore, Month(Dt) - numMonthsBefore, Day(Dt) - numDaysBefore)
End Function
Make changes as needed, i.e. sheet name (I called mine "Stock Prices"), and the columns. It's also a little verbose, and could be made more compact, but I figured it'd help you learn to keep it like that. I suggest stepping through with F8 to see what happens, and uncommenting the .select lines so you can visually see what it's doing.
I am trying to get 2 days behind the current date provided Saturday, Sunday and Holidays or not included.
Table where my holidays are stored - [DateTable[Holidays]]
I know it requires the usage of Application.NetworkDays_Intl, but I am not able to get the logic going.
Does Anyone know what is the easy way to achieve this >
The function NetworkDays_Intl takes a start date and an end date and calculates the number of workdays in the range. This forces a slightly cumbersome approach:
Dim StartDate As Date
Dim EndDate As Date
Dim Duration As Integer
Duration = 2
EndDate = CDate("2017-07-08")
' Pick theoretically latest start date
StartDate = DateAdd("d", -Duration + 1, EndDate)
' Step one day back until we get it right
Do While Application.NetworkDays_Intl(StartDate, EndDate) <> Duration
StartDate = DateAdd("d", -1, StartDate)
Loop
Debug.Print StartDate
Column A is StartDate
Column B is EndDate
When I run the Macro it returns the answer 1 for all my dates as I am adding 1 to my DateDiff, then DateDiff must be 0.
What is wrong with my DateDiff ?
Sub CalculateDays()
Dim LastRow As Long
Dim StartDate As Date
Dim EndDate As Date
Dim Days As Single
With Worksheets("Sheet1")
'Determine last Row in Column A
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'Calculate Difference between Start Date And End Date in Days
For i = 2 To LastRow
StartDate = .Cells(i, 1)
EndDate = .Cells(i, 2)
Days = DateDiff("d", StartDate, EndDate)
.Cells(i, 3) = Days + 1
Days = 0
Next i
End With
End Sub
Sample data:
Start Date | End Date
=========================
13-Feb-17 | 28-Feb-17
14-Feb-17 | 28-Feb-17
02-Mar-17 | 04-Mar-17
13-Feb-17 | 15-Feb-17
13-Feb-17 | 13-Feb-17
15-Jan-17 | 15-Feb-17
01-Feb-17 | 12-Feb-17
Your code actually runs fine for me - but I am sure that the values in columns A and B are actually dates. If you are not sure about this then use the CDate function to ensure that the value in the cells is converted to a date before passing to the DateDiff function e.g.
StartDate = CDate(.Cells(i, 1).Value)
Your code with this added in:
Option Explicit
Sub CalculateDays()
Dim LastRow As Long
Dim StartDate As Date
Dim EndDate As Date
Dim Days As Single
Dim i As Long
With Worksheets("Sheet1")
'Determine last Row in Column A
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'Calculate Difference between Start Date And End Date in Days
For i = 2 To LastRow
StartDate = CDate(.Cells(i, 1).Value)
EndDate = CDate(.Cells(i, 2).Value)
Days = DateDiff("d", StartDate, EndDate)
.Cells(i, 3) = Days + 1
Days = 0
Next i
End With
End Sub
Edit
I just read this where it states a problem with South African date formats:
.. my region was "English (South Africa)") and I had the date separator as "/", however Excel kept changing this to a "-". ...
So maybe it's worth checking on your regional settings and maybe reformat your dates as dd/mmm/yyyy instead of dd-mmm-yyyy and checking the output.
Maybe the CDATE function will not be required after all (as I mentioned your code ran fine for me in an Australian English regional setting context).
Alternatively, instead of a function just write a formula:
=ROUND(B2-A2+1,0)
why do you need datediff function. to get the days difference use
days=enddays - startdate
your code is working fine in excel 2016 in widows. As mentioned by #RobinMackenzie you have some problem with regional date settings.
I currently have an Excel sheet with a series of dates and a cell in a different sheet with the date when we last ran this macro.
I need to write a macro which checks if today's date is at least 32 days after the day we last ran the macro.
If so, I want to search the sheet with the series of dates and add 10-dates to a dates array.
The dates that we add represent each the closes n*30 days prior to today's date with n which goes from 1 to 10.
So basically 10-dates each representing a multiple of 30-days prior to todays date.
BUT, these dates must be present in the sheet with the series of dates mentioned above so if for example subtracting 30 days from today gives a date which does not exist in the series of dates above, we keep subtracting 1 additional day until we find a date which exists.
Hope this makes sense. I understand it is a bit confusing but I felt I had to give some context.
My code:
Sub date_diff()
Dim todDate
Dim dt
Dim diff As Long
Dim dates(0 To 9) As Date
Dim i As Long
todDate = Format(ActiveWorkbook.Sheets("Overview").Range("B6").Value, "mm/dd/yyyy")
' dt is the Date of last signaling
dt = ActiveWorkbook.Sheets("Overview").Range("B5").Value
diff = DateDiff("d", dt, todDate)
Dim rng As Range
Dim dtCell As Range
Dim currDt
If diff < 32 Then
MsgBox "Wait " & (32 - diff) & " days"
Else
For i = 1 To 10
currDt = Format(DateAdd("d", 20, todDate), "mm/dd/yyyy") ---> OVERFLOW HERE
Set rng = ActiveWorkbook.Sheets("US Stocks").Range("A:A")
' Find the day - Loop until you find one at least 30 days apart
Do While rng.Find(What:=currDt) Is Nothing
currDt = DateAdd("d", -1, currDt)
Loop
dates(i) = currDt
MsgBox i
Next i
End If
End Sub
Run-time error '6':
Overflow
I suppose the error is coming from how I handle or how the dates are interpreted in VBA. SEE CODE FOR OVERFLOW LINE. I am very new to VBA so am still learning these subtleties. FYI, the dates are in the "Short Date" format such as 1/13/15 (mm/dd/yy).
In my worksheet, I have 2 cells that serve to denote the minimum date and maximum date. Also in the worksheet, I have a table structure. What I'd like to achieve, is to have extra columns appended to the end of the table showing each month in between those 2 dates, inclusive.
For example, minimum date is 7/31/2014 and maximum is 6/30/2015. I would like a macro to populate the column headers 7/31/2014, 8/31/2014, ..., 6/30/2015 to the end of my table.
Unfortunately, Excel tables can't have dynamic headers. I then thought of using VBA by having an array of dates, and then setting the Range.Value to the array, but couldn't quite figure out how to code it.
Thank you.
You want DateAdd()
Assuming you want to get the last date of every month you should instead use DateSerial()
Public Sub test()
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
startDate = CDate("7/31/2014")
endDate = CDate("6/30/2015")
currentDate = startDate
Do While currentDate <= endDate
MsgBox currentDate
'currentDate = DateAdd("m", 1, currentDate)
currentDate = DateSerial(Year(currentDate), Month(currentDate) + 2, 0)
Loop
End Sub
You don't really need VBA. A pretty simple Excel formula will do the trick.
In the example below, cell C5 has =$C$2. Cell C6 has this formula:
=IF(C5>=$C$2,"",DATE(YEAR(C5),MONTH(C5)+2,DAY(0)))
and, for the purposes of this example, it is copied down to cell C23. You would just have to copy it as far down as you would need in your longest conceivable table.
Explanation: the formula adds 2 months to the previous date, but then takes "day 0" of that month which is equivalent the last day of the month before (which I think is what you want based on your example). If the previous date has reached the max, then it just writes an empty string "" from then on.
Maybe you want this in a row, not a column; the idea is the same.
Here is a small example based on:
Here is the code:
Sub MAIN()
Dim d1 As Date, d2 As Date, Tbl As Range
d1 = Range("A1").Value
d2 = Range("A2").Value
Set Tbl = Range("B3:E9")
Call setLabels(d1, d2, Tbl)
End Sub
Sub setLabels(dt1 As Date, dt2 As Date, rng As Range)
Dim rToFill As Range, r As Range
Set rToFill = Intersect(rng(1).EntireRow, rng).Offset(-1, 0)
For Each r In rToFill
dv = dt1 + i
r.Value = dv
i = i + 1
If dt1 + i > dt2 Then Exit Sub
Next r
End Sub
This is based on 1 day increments. If you want 1 month increments, then use this for dv
dv = DateSerial(Year(dt1), Month(dt1) + i, Day(dt1))
VBA has functions that handle dates. If you look at the link:
http://software-solutions-online.com/2014/02/21/excel-vba-working-with-dates/
It will show you how to make variables of data type Date using VBA, which will make adding and subtracting months very easy for you.
After that, add methods to create the columns you want and the .Name property to name the columns.