I am having an issue comparing Dates in excel. One date values is pulled from a worksheet and is in the form "24-JAN-17". The other data is declared in the script in from "2017-12-31". Does anyone know a solution to comparing the two dates so I can determine if the date value pulled from the sheet is later than 2018. I have included the code in it's current state below.
Sub removeWrongYear()
Dim i As Long, yearA As Long, rowsCnt As Long
Dim rowsToDelete As Range
Dim vData As Variant
yearA = 2017
With ActiveSheet
'1st to 635475 row, 20th column
vData = Range(.Cells(1, 20), .Cells(635475, 20))
For i = UBound(vData) To 2 Step -1
If vData(i, 1) > DateSerial(yearA, 12, 31) Then
rowsCnt = rowsCnt + 1
If rowsCnt > 1 Then
Set rowsToDelete = Union(rowsToDelete, .Rows(i))
ElseIf rowsCnt = 1 Then
Set rowsToDelete = .Rows(i)
End If
End If
Next i
End With
If rowsCnt > 0 Then
Application.ScreenUpdating = False
rowsToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End If
End Sub
You are working with string literal values on the worksheet, which represent dates in a US date format (DD-MMM-YY). These are not Date values, they're just strings. So when you try to parse it like a string like "22-JAN-18" e.g. using the Year function, my understanding is that it should return "2018". But working with different locale settings can be tricky, and this is complicated by the fact that VBA -- despite locale settings -- always (?) interprets dates in US format.
Can you test this:
Sub test()
Dim s as String
s = "22-JAN-18"
Debug.Print Year(s)
End Sub
If that's not working, try:
Debug.Print Year(Format(s, "DD-MMM-YY"))
That may work, because you're explicitly specifying the format of the date-like string.
If that works, then try:
Dim theDate as Date
theDate = DateValue(Format(vData(i, 1), "DD-MMM-YY"))
If Year(theDate) > yearA Then
...
One date values is pulled from a worksheet and is in the form "24-JAN-17". The other data is declared in the script in from "2017-12-31".
To compare two variables, the best way is to make sure that they are of the same type. Thus, try to parse them as dates. Then compare:
Public Sub TestMe()
Dim dt1 As Date: dt1 = "24-JAN-17"
Dim dt2 As Date: dt2 = "2017-12-31"
Debug.Print Year(dt1) < 2017
Debug.Print Year(dt1)
End Sub
In your code > DateSerial(2016, 12, 31) is pretty much the same as Year(dt1) < 2017, but taking the year seems a bit easier.
Related
I have seen examples on how to create an array of all the dates, or a date every month between a start date and end date here. However, I am trying to create an array of dates every 2 weeks specifically between a start and end date.
Ex. if startdate = 7/18/2021 and enddate = 12/28/2025, I want an array that is:
array = {7/18/2021, 8/1/2021, 8/15/2021, ..., 12/28/2025}
How exactly can I do this? I tried using a recorded macro but it only uses the xlFillDefault and doesn't actually specify the algorithm used.
Sub get2weekdates()
'
' get2weekdates Macro
'
'
ActiveCell.FormulaR1C1 = "7/18/2021"
Range("D6").Select
ActiveCell.FormulaR1C1 = "8/1/2021"
Range("D5:D6").Select
Selection.AutoFill Destination:=Range("D5:D121"), Type:=xlFillDefault
Range("D5:D121").Select
End Sub
The idea of the Function ArrayWithDates() is to take 2 parameters - the first day and the size as an optional one (in the example, 14 is 2 weeks, you may write 21 for 3 weeks or 20 for 2 weeks and 6 days).
Once it gets these, it enlarges the array based on the size with this line - ReDim result(size - 1). As the 0th element of the array is known, it is assigned outside the loop - result(0) = firstDay.
Then, in the loop, the other elements are assigned, and each one is the next day, using DateAdd():
Public Sub TestMe()
Dim i As Long
Dim myArray As Variant
myArray = ArrayWithDates(#7/18/2021#)
For i = LBound(myArray) To UBound(myArray)
Debug.Print i; myArray(i)
Next i
End Sub
Public Function ArrayWithDates(firstDay As Date, Optional size As Long = 14) As Variant
Dim i As Long
If size < 1 Then
ArrayWithDates = Array()
Exit Function
End If
ReDim result(size)
result(0) = firstDay
For i = 1 + LBound(result) To UBound(result)
result(i) = DateAdd("D", 1, result(i - 1))
Next i
ArrayWithDates = result
End Function
The result looks as expected:
Dates are just doubles that look like a date. we just need to loop and add 14 to the start till we hit the end date:
Sub get2weekdates()
With ActiveSheet
Dim strtdt As Double
strtdt = .Range("C1").Value2
Dim eddt As Double
eddt = .Range("c2").Value2
Dim nmDts As Long
nmDts = (eddt - strtdt) / 14 + 1
Dim otArray As Variant
ReDim otArray(1 To nmDts, 1 To 1)
Dim i As Long
For i = 1 To nmDts
otArray(i, 1) = strtdt + ((i - 1) * 14)
Next i
.Range("D5").Resize(nmDts, 1).Value = otArray
.Range("D5").Resize(nmDts, 1).NumberFormat = "mm/dd/yyyy"
End With
End Sub
But as stated by #pdtcaskey with Office 365 this can be a simple formula:
=SEQUENCE((C2 - C1)/14 + 1,, C1, 14)
I have a word table. I wrote a macro to get values from the table. When it runs I get a runtime error 13. When I debug and watch the value of parsing string it looks like this "2019-04-03 There is only one quote in the string. I think that is the case I couldn't convert that string into a date format. Can you help me to fix this?
The code
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
days = Selection.Tables(1).Rows(J).Cells(6).Range.Text
FormatDate = CDate(ends)
endDate = DateAdd("d", days, FormatDate)
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
The table
Here's the minimal change I found that works for me when tested in Word 2013.
General points:
I added Option Explicit so that the computer would help me find errors. In this case, the variables J and FormatDate were used but not Dimed, and ends was used but never initialized (I changed it to startDate).
The Range.Text in a table cell includes whitespace and the end-of-table marker (ยค). That is why CDate was giving an error.
For the dates, I used Left() to take only the left ten characters, since you seem to always be using yyyy-mm-dd-format dates.
For the counts of days, since those can be of any length, I used Range.Words(1).Text to keep only the first Word (as MS Word defines it), which is the number.
I also added the CLng() call in the parameter to DateAdd, since DateAdd wants a number* rather than a string.
For production use, I would also recommend using Selection only in one place, and doing Dim workTable as Table: Set workTable = Selection.Tables(1). That will simplify your code.
Code
<=== marks changed lines
Option Explicit ' <==
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
Dim J As Long ' <==
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
startDate = Left(startDate, 10) ' <== Remove the space and table mark
days = Selection.Tables(1).Rows(J).Cells(6).Range.Words(1).Text ' <===
Dim FormatDate As Date ' <==
FormatDate = CDate(startDate) ' <== not `ends`
endDate = DateAdd("d", CLng(days), FormatDate) ' <=== clng
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
* DateAdd actually takes a Double, but VBA can promote Long to Double. I chose CLng since it looks like you are only using integer day spans. If not, use CDbl instead.
Try:
Sub Demo()
Dim r As Long
With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For r = 2 To .Rows.Count
.Cell(r, 7).Range.Text = _
Format(DateAdd("d", Split(.Cell(r, 6).Range.Text, vbCr)(0), CDate(Split(.Cell(r, 5).Range.Text, vbCr)(0))), "YYYY-MM-DD")
Next r
End With
End With
End Sub
So the titles a bit of a mess but im trying to do the following:
I have a range of cells from Q8:Q12, T8:T12, Q16:Q20 and T16:T20
Im trying to have these cells populate with the date for each friday of this current month. Essentially, using July (The current month) it would look something like this:
Q8/T8 = 06/07
Q9/T9 = 13/07
Q10/T10 = 20/07
Q11/T11 = 27/07
Q12/T12 = -
The reason Q/T12 would be blank is to handle months of the year that have 5 fridays in them rather than 4. Its kind of a way of error handling.
I have a cell that currently tracks the month within the Cell A9 and the formula looks like this:
=TEXT(NOW(),"mmmm")
Im not quite sure how to handle this logically really. Either VBA or a Formula would do in my eyes.
Ideally, because i have a different sheet for every month July, August etc. The formula above changes depending on what month it is currently. I would need to convert the Formula/VBA script from cells Q8:Q12 OR A9 into a value AFTER populating the date range cells Q8:Q12.
Anyone have any ideas. Im sorry its a bit of a messy question
excel-formula
Put this in the first cell and copy down 5
=IFERROR(AGGREGATE(15,6,ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0)))/(WEEKDAY(ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0))),1)=6),ROW(1:1)),"-")
Then format to your specifications.
There are probably more elegant formulas but this is what came to mind.
Here is a macro version without needing a date value in Range("A9")...
Dim SoM As Date
Dim EoM As Date
Dim rw As Long
SoM = DateSerial(Year(Now), Month(Now) + 0, 1)
EoM = DateSerial(Year(Now), Month(Now) + 1, 0)
rw = 8
While SoM < EoM
If Weekday(SoM) = vbFriday Then
Cells(rw, 17).Value = SoM
Cells(rw, 17).NumberFormat = "m/d/yyyy"
rw = rw + 1
End If
SoM = SoM + 1
Wend
I made a user defined function that works with any date range, then show how it could be applied to this example with a few formulas. This would account for year to year transitions.
Function DAYOFWEEKFREQUENCY(ByVal dayOfWeekType As String, ByVal startDate As String, ByVal endDate As String) As Long
Dim myStartDate As Date
myStartDate = CDate(startDate)
Dim myEndDate As Date
myEndDate = CDate(endDate)
Dim includeStartDate As Long
includeStartDate = 1
Dim daysBetweenDatesInclusive As Long
daysBetweenDatesInclusive = Application.WorksheetFunction.Days(endDate, startDate) + includeStartDate
Dim vbStartDay As Long
vbStartDay = Weekday(startDate)
Dim dateCheckedIncremented As Date
dateCheckedIncremented = myStartDate
For dayCounter = 1 To daysBetweenDatesInclusive
If Weekday(dateIncrementedChecked) = dayOfWeekType Then
DAYOFWEEKFREQUENCY = DAYOFWEEKFREQUENCY + 1
End If
dateIncrementedChecked = DateAdd("d", 1, dateIncrementedChecked)
Next
End Function
In Excel using VBA, I need to set a variable to equal a list of all the dates between a start and end date (similar to equaling a range containing multiple values). The catch is only the start and end date are in a range, non of the values in between.
In SQL Server I've used the Sys.Columns table to generate a list of dates between two dates that are not actually stored on that table. Is there a way to do something similar here without having each date between the start and end date written somewhere? I googled for a couple hours and didn't find anything on how to do this.
What I'm attempting to do is have a variable I can do a For Each loop on. So for each date I will check if it exists in another worksheet, if it does nothing will happen, if it does not it will be added.
I've tried:
Dim DatesInSettings As Date
DatesInSettings = StartDate To EndDate
For Each Date In DatesInSettings
'Insert commands here
Next DatesInSetting
But that clearly isn't the answer. Help?
This searches Sheet2 for dates between the start date and end dates on Sheet1 - in cells A1 and B1:
Sub RunDates()
Dim StartDate As Date
Dim EndDate As Date
Dim i As Date
StartDate = Sheet1.Range("A1")
EndDate = Sheet1.Range("B1")
For i = StartDate To EndDate
If WorksheetFunction.CountIf(Sheet2.Range("A1:A5"), i) > 0 Then
Debug.Print i; "- date found"
Else
Debug.Print i; "- date not found"
End If
Next i
End Sub
The following subroutine calls a dictionary that will store all the dates between two given endpoints. Then it uses a simple existence comparison to check if the dates on your list is inside the dictionary's items. If it's not, it's going to print them out as not in the list.
Modify accordingly to suit your needs. ;)
CODE:
Sub GetListOfDates()
Dim StartDate As Date, EndDate As Date
Dim DictOfDates As Object, DateToCheck As Variant, ListOfDates As Variant
Dim Iter As Long
Set DictOfDates = CreateObject("Scripting.Dictionary")
StartDate = "12/31/2013"
EndDate = "01/15/2014"
For Iter = StartDate + 1 To EndDate - 1
With DictOfDates
If Not .Exists(Iter) Then
.Add Iter, Empty
End If
End With
Next Iter
'--Print them somewhere.
'Range("A1").Resize(DictOfDates.Count, 1).Value = Application.Transpose(DictOfDates.Keys)
ListOfDates = Range("B1:B15").Value
For Each DateToCheck In ListOfDates
If Not DictOfDates.Exists(DateToCheck) Then
Debug.Print Str(DateToCheck) + " is not in the list!" '--Or whatever action you want.
End If
Next DateToCheck
Set DictOfDates = Nothing
End Sub
Let us know if this helps. :)
I solved it with a vector.
I hope it helps
Sub Dates_Vector()
Public Dates() As Date
ReDim Dates(End_Dat - Start_Date)
For x = 0 To End_Dat - Start_Date
Dates(x) = Dat_Ini + x
Next x
For Each Date In Dates
'Insert commands here
Next Date
End Sub
I cannot find the mistake. The error msg gives me "runtime error '13'" data types don't match. The error seems to be in the function "fillcalweeks".
Fillcalweeks should return an array which is filled with start and end dates which are located in a sheet.
Here's my code:
'For every calenderweek we need the start and end dates in an array to produce the timeline
Sub get_cal_weeks()
Dim weeks As Integer, i As Integer, col As String, weekstart As Date, weekend As Date
'start column is D
col = "D"
'get amount of weeks
weeks = countcalweeks()
'populate array calweeks
calweeks = fillcalweeks(weeks)
For i = 0 To weeks
Sheets("Kalenderwochen").Range("E" & i + 1) = calweeks(i, 1)
Next
End Sub
Function fillcalweeks(weeks As Integer) As String()
Dim i As Integer, datestart As Date, dateend As Date, calweek As Integer, returnarray() As String
For i = 0 To weeks
'date start & date end
datestart = Sheets("Kalenderwochen").Range("A" & i + 1).Value
dateend = Sheets("Kalenderwochen").Range("B" & i + 1).Value
calweek = Sheets("Kalenderwochen").Range("C" & i + 1).Value
returnarray(i, 1) = datestart
returnarray(i, 2) = dateend
returnarray(i, 3) = calweek
fillcalweeks = returnarray
Next
End Function
'Counts the calenderweeks in the Kalenderwochen sheet
Function countcalweeks() As Integer
countcalweeks = Sheets("Kalenderwochen").Range("A2").End(xlDown).row
End Function
Thx for the help
You are getting an error on the line calweeks = fillcalweeks(weeks) because you are assigning a String array (the result of the function fillcalweeks to a Variant.
You'll notice you declared every variable except calweeks. Since VBA doesn't have an explicit declaration for this variable it assigns it to a Variant.
To fix the problem, start by putting Option Explicit at the top of every module. When you compile the project, it'll alert you to errors such as these (Debug -> Compile VBA Project). Then all you need to do is declare calweeks as a String().
There is a second problem you have and that is that you are trying to store a Date data type in your String() array within the fillcalweeks. You either need to convert the datestart, dateend and calweek variables to Strings (you can use the VBA.CStr() function to do this) or change the function fillcalweeks to return a Date array.
Finally, you need to declare a size range for the returnarray() within fillcalweeks. VBA needs to know how big this is before it can fill the values. Since you know how many rows there are (its an input to the function) this is as simple as replacing the declaration of returnarray with ReDim returnarray(0 To weeks - 1, 1 to 3) As String. Note you want to dimension the array to weeks - 1 since you have a base of zero not one.
One more error is that when you output back to the worksheet the loop needs to be For i = 0 To weeks - 1 otherwise the array will be out of bounds...
Thx. I found all the mistakes in the code. 1. declaration of calweeks and 2. the array dimension:
'For every calenderweek we need the start and end dates in an array to produce the timeline
Sub get_cal_weeks()
Dim weeks As Integer, i As Integer, col As String, weekstart As Date, weekend As Date, calweeks() As Variant
'start column is D
col = "D"
'get amount of weeks
weeks = countcalweeks()
'populate array calweeks
calweeks = fillcalweeks(weeks)
For i = 0 To weeks
field = i + i + 4
weekstart = calweeks(i, 0)
weekend = calweeks(i, 1)
Cells(5, field) = monetary_calc_week(weekstart, weekend)
Next
End Sub
Function fillcalweeks(weeks As Integer) As Variant()
Dim i As Integer, datestart As Date, dateend As Date, calweek As Integer, arraysize As Integer, returnarray() As Variant
arraysize = 52
weeks = weeks - 2
ReDim Preserve returnarray(arraysize, 3)
For i = 0 To weeks
If i > arraysize Then
arraysize = arraysize * 2
ReDim Preserve returnarray(arraysize, 3)
End If
'date start & date end
datestart = Sheets("Kalenderwochen").Range("A" & i + 2).Value
dateend = Sheets("Kalenderwochen").Range("B" & i + 2).Value
calweek = Sheets("Kalenderwochen").Range("C" & i + 2).Value
returnarray(i, 0) = datestart
returnarray(i, 1) = dateend
returnarray(i, 2) = calweek
Next
fillcalweeks = returnarray
End Function
'Counts the calenderweeks in the Kalenderwochen sheet
Function countcalweeks() As Integer
countcalweeks = Sheets("Kalenderwochen").Range("A2").End(xlDown).row
End Function