Overflow when using DateAdd Excel VBA - vba

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).

Related

Earliest date in VBA/Excel gives 00:00:00

I have a set of dates pulled from a PivotTable (which can either be accessed straight from the PT or I can copy it into a new sheet - I'm not fussed either way) and I need both the earliest and latest date e.g.
Scheduled date
01/01/17
05/08/17
08/11/16
03/12/16
...
So all I want is for VBA to tell me that the earliest date is 08/11/16 and the latest is 05/08/17 (This is part of a macro that cycles through different versions of different assessments, so a manual fix won't suffice and the model is so large that an array formula in the sheet is going to make it ridiculously slow).
So far I have tried the following for the earliest date:
Dim AllDates As Variant
Dim NumberDates As Integer
Dim Earliest As Date, Latest As Date
Set AllDates = ThisWorkbook.Sheets("Pivot Table 5 - To Use").Range("A4:A203")
'Attempt 1
Earliest = WorksheetFunction.Min(AllDates)
'Attempt 2
Earliest = Format(Application.Min(AllDates), "dd/mm/yyyy")
'Attempt 3
Earliest = Format(WorksheetFunction.Min(AllDates), "dd/mm/yyyy")
'Attempt 4
Debug.Print CDate(Application.Max(AllDates))
Every attempt results in "00:00:00" so I'm assuming I am actually working with Date values (I doubled checked and ensured that the worksheets were formatted to the correct date format) but beyond that I am COMPLETELY stumped.
This worked for me:
Sub test()
Dim Earliest As Date
Dim Latest As Date
AllDates = "$A$2:$A$204"
Earliest = Application.WorksheetFunction.Min(ActiveSheet.Range(AllDates))
Latest = Application.WorksheetFunction.Max(ActiveSheet.Range(AllDates))
MsgBox Earliest & Chr(13) & Latest
End Sub

VBA - Selecting cells that contain dates for the past 5 years

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.

Excel VBA code to compare system date with date in the worksheet

I want a vba code to compare the system date with the date i mentioned in a row (A) in excel worksheet. If the dates are equal then it should compare the system time and the time mentioned in a row (B). Eg: If the time mentioned in the sheet is 7 30 PM and the system time is 7 PM, it should calculate the time between and display. If the date in the sheet does not matches then it should leave.
Thanks in advance.
I put together a small procedure to get you started. It assumes the date/time in the worksheet is in cell A1. If the system date is the same as the date in cell A1, it then compares the system time with the time in cell A1. If they are the same to the minute then nothing happens.
However, if they are different then the number of minutes by which they are different appears in cell B1.
Here is the code:
Public Sub DateTimeCheck()
Dim d As Double
Dim s1 As String
Dim s2 As String
s1 = Format([a1], "dd-mm-yyyy hh:mm")
s2 = Format(Now, "dd-mm-yyyy hh:mm")
If Left$(s2, 10) = Left$(s1, 10) Then
d = TimeValue(Right$(s2, 5)) - TimeValue(Right$(s1, 5))
If d Then
[b1] = d * 1440
End If
End If
End Sub
Now, if you have more cells with dates in column A and you want to compare them as well, then you will need to modify this code so that it "processes" all of them.
As far as writing the difference in minutes to the email... we would need much more detail for that!

Array of month end dates between 2 dates

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.

Determine how many days into the year a certain date is when the date is determined by a variable

What I am trying to do is check column AJ for each date that occurs during a year determined by variable "Año". For the dates that are I would like to see how far into the year they are (that is how many days after the first January each date occurs); this is the part that is giving me the error (indicated in my code). What I need is a function to give how many days into the year a date occurs or a better way of writing that line of code.
For Each cl In Workbooks(WbkA).Worksheets("Sheet1").Range("AJ2:AJ1000")
If (cl.Value - ("01/01/" & Año)) > 0 And (cl.Value - ("01/01/" & Año)) < 366 Then 'if it´s in this year
ValueA = ValueA + (cl.Value * ((cl.Offset(0, -13).Value - ("01/01/" & Año)) / 365)) ' this part is giving me the error
End If
End If
Next cl
You are complicating things too much. DateDiff can perform the calculations you want:
Dim iniDate As Date, curDate As Date
Dim ValueA As Integer, Año As Integer
Año = 2010
iniDate = Format(CDate("01/01/" & Año), "MM/dd/yyyy") 'You can change the Format
curDate = Format(CDate("01/05/" & Año), "MM/dd/yyyy")
ValueA = DateDiff("d", iniDate, curDate) 'RESULT -> 4
Dates are stored as the number of days since 1/1/1900, so you can just subtract two dates to get the number of days.
Dim lAno As Long
Dim rCell As Range
Dim dValueA As Double
lAno = 2010
For Each rCell In Sheet1.Range("AJ2:AJ100").Cells
If Year(rCell.Value) = lAno Then 'if it's in the year
'+= some value * the number of days
dValueA = dValueA + (rCell.Offset(0, -13).Value * (rCell.Value - DateSerial(lAno, 1, 1)))
End If
Next rCell