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

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

Related

Error When Trying to Filter Pivot Table With Between Dates Using vb.net

I'm automating a number of reports using a vb.net winforms application. I have one report where I need to update the filter on a Date Field to between 2 dates (Monday & Sunday or the week in question).
I'm getting the dates by having the user select an End Date from a DateTimePicker dateStatusEnd
When the code gets to adding the filter I get the below error message:
The dates are valid because I mistakenly thought I had added them in the wrong order but this gave an error saying the end date had to be less then the start date so it's definitely reading them as errors.
Any ideas how I can resolve this? Code snippet below:
xlSht = aWorkBook.Worksheets("RBA Expiry Dates")
Dim xlPivot As PivotTable = xlSht.PivotTables("PivotTable1")
Dim xlPivotField As PivotField = xlPivot.PivotFields("RBA Expiry Date")
xlPivotField.ClearAllFilters()
If dateStatusEnd.Value.Day = 31 AndAlso dateStatusEnd.Value.Month = 12 And dateStatusEnd.Value.Date.ToString("dddd") <> "Sunday" Then
Dim aDate As Date = dateStatusEnd.Value.Date
Do Until aDate.ToString("dddd") = "Monday"
aDate = aDate.AddDays(-1)
Loop
xlPivotField.PivotFilters.Add2(Type:=XlPivotFilterType.xlDateBetween, Value1:=aDate.ToShortDateString, Value2:=dateStatusEnd.Value.Date.ToShortDateString)
Else
xlPivotField.PivotFilters.Add2(Type:=XlPivotFilterType.xlDateBetween, Value1:=dateStatusEnd.Value.Date.AddDays(-6).Date.ToShortDateString, Value2:=dateStatusEnd.Value.Date.ToShortDateString)
End If
In case anyone else comes across this in the future, it turns out that somewhere between opening the file & applying the filter the Pivot has stop recognising the date column as a date column.
Now I just need to figure out why that's happening 😢

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.

Overflow when using DateAdd Excel 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).

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.

Comparing Date Range Excel VBA

UPDATED WITH ANSWER: I found an answer to my question. I'll place a simplified version below the original question here, just to make it easy, with a more detailed version below as the accepted answer.
I'm writing a VBA function to filter a pivot table by a date range entered by the user. For some reason, it is not returning the results expected.
The dates being compared are in two different date formats. The user-entered dates are in mmmm yyyy format (October 2013). When this value is pulled into the macro for comparison, it is translated correctly as 10/1/2013. The pivot table dates are in mmm yy format (Oct 13). When I call on this date with the code PivotItem.Value it seems to be translating the date as a string "Oct 13."
I can't quite figure out what the macro is doing, as it behaves somewhat erratically. If I run it for October 2011 to October 2013, it returns all months from Jan to September for every year, 2008, 2009, 2010, etc. If I run it for June 2013 to October 2013, it returns June to September for every year. Furthermore, in each example, the macro continues to run past the maximum range of data in the pivot table and gets an error. When I debug, the macro is trying to set the visibility to 'true' for a date that doesn't even exist in the pivot table (IE for Jan 2014 when the data only goes through Oct 2013). No idea why that's happening.
Below is the code. Any insight would be greatly appreciated.
UPDATE:
So the problem is definitely the date format. If I change the field settings in the pivot table to the date format mm/dd/yyyy (10/1/2013), then the macro works exactly as expected. This would be a simple fix to the problem except that the table is feeding a chart seen in the user dashboard, which I would really like to be in the format mmm yy, since it looks much cleaner. Is there a simple way to convert the format to mm/dd/yyyy inside the macro for the comparison, then back to the desired format once complete?
And I would still like to understand why a different date format is returning such different results, when the raw data being compared is the same, and both are formatted as dates, not like date vs text or something.
Sub filterPivotDate(pt As PivotTable, strtDate As Date, endDate As Date)
Dim pf As PivotField
Dim pi As PivotItem
'Clear current date filter
Set pf = pt.PivotFields("Date")
pf.ClearAllFilters
'Set new date filter
For Each pi In pf.PivotItems
If pi.Value >= strtDate And pi.Value <= endDate Then
pi.Visible = True
Else
pi.Visible = False
End If
Next pi
end sub
ANSWER UPDATE:
I replaced the loop I was using to set the filter with the following line of code:
pf.PivotFilters.Add Type:=xlDateBetween, Value1:=strtDate, Value2:=endDate
This solved the issue I was having with the date format. More information in the accepted answer below, as well as at this website
I might be wrong, but one of your < characters looks backwards- don't you want start dates Greater than the variable?
You could try converting the string date value first:
Dim dateValue as Date
'Set new date filter on all pivot tables
For Each pt In ws.PivotTables
Set pf = pt.PivotFields("Date")
For Each pi In pf.PivotItems
If IsDate(pi.Value) Then
dateValue = CDate(pi.Value)
If dateValue < strtDate Or dateValue > endDate Then
pi.Visible = False
Else
pi.Visible = True
End If
End If
Next pi
Next pt
'call this function
Function IsDate(byval thisDateString as String) As Boolean
On Error Goto ErrorHandler
Dim d as Date
d = CDate(thisDateString)
IsDate = true
Exit Function
ErrorHandler:
IsDate = false
End Function
I found some additional information about setting pivot table filters via VBA that improves upon the original code and solves the issue I was having. I decided to post it, as I found the information extremely helpful.
There are a lot of different filters you can set with simple, one line commands, rather than complicated loops which parse all the data and set visibility manually based on a condition as I was doing before. Below is the updated code, which also solved the issue I was having with the date formatting.
There is some really useful information at this link to the globaliconnect website about different pivot table filter settings you can set using VBA.
I'm still not certain why the date was behaving weird before when doing the comparison in a loop, but dates are just kinda like that I guess...
Sub filterPivotDate(pt As PivotTable, strtDate As Date, endDate As Date)
Dim pf As PivotField
Application.ScreenUpdating = False
'Clear date filter and set new filter
Set pf = pt.PivotFields("Date")
pf.ClearAllFilters
'I REPLACED THE LOOP WITH A SINGLE LINE TO SET A FILTER BETWEEN TWO DATES
pf.PivotFilters.Add Type:=xlDateBetween, Value1:=strtDate, Value2:=endDate
Application.ScreenUpdating = True
End Sub