I have a row of trading dates, stored in Column A. It contains trading days and hence, it doesn't contain all the days in a year. I would like to get a particular date and remove one year from it. I would like to find the index of the newdate cell within the same column. If not possible I would like to find the next closest date.
What I have tried so far:
Dim date1 As Double
date1 = Sheets("Part2").Cells(i, 1).Value
Dim matchRow As Integer
matchRow = 3
While Sheets("1.A").Cells(matchRow, 1).Value <> date1
matchRow = matchRow + 1
Wend
I am able to get a particular date in sheet but now I need to get the date one year before that, if not next nearest date after that.
Need some guidance on doing this.
Also tried:
Sheets("Part2").Cells(i, 1).Value -365. It is not working..
Use DateAdd:
DateAdd("yyyy",-1,Sheets("Part2").Cells(i, 1).Value)
UPD since your dates are stored as text in format "yyyymmdd" and starts from row №3, use this one:
Dim date1 As Date
Dim srtDate1 As String, srtDate2 As String
Dim matchRow
strDate1 = Sheets("Part2").Cells(i, 1).Value
date1 = DateSerial(Left(strDate1, 4), Mid(strDate1, 3, 2), Right(strDate1, 2))
srtDate2 = Format(DateAdd("yyyy", -1, date1), "yyyymmdd")
matchRow = Application.Match(CDbl(srtDate2), Sheets("Part2").Range("A:A"), 1)
If IsError(matchRow) Then
matchRow = 3
Else
matchRow = matchRow + 1
End If
MsgBox "new date: " & Sheets("Part2").Range("A" & matchRow)
Related
I am trying to split a column that contains a combination of Date and Time into two columns, where date and time are separated.
Column C contains a combination of date and time, for example "2022-01-01 09:30:00".
This should be split into Date in Column D and Time in Column E, in the format "dd.mm.yyyy" and "hh:mm":
Column D with 01.01.2022
Column E with "09:30"
I need to compare with a different sheet, where they are in this format.
Although I managed to split Date and Time into two columns the Time format is wrong.
I found suggestions to use Int() to get the date, and then subtract to get the time, however my date seems to be string. I tried to format my column to a Date datatype by using the Cdate function, however this resulted in an error.
As I don't necessarily need the value to have this datatype, I thought I could work with the Left() and Right() function. This first gave a problem but by including a string in between, I am getting closer to what I want.
Dim iAircol As Integer
Dim lastrow As Integer
Dim i As Integer
Dim str1 As String
Dim str2 As String
Dim spacepos as Int
iAircol= Worksheets(ws).Cells.Find(What:="Airdate", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
spacepos = InStr(Cells(i, iAircol), " ")
str1 = Left(Cells(i, iAircol).Value, spacepos)
Cells(i, iAircol + 1) = str1
str2 = Left(Right(Cells(i, iAircol).Value, Len(Cells(i, iAircol)) - spacepos), 6)
Cells(i, iAircol + 2) = str2
Next i
Time value still is in "hh:mm:ss":
I give the cell the first 5 characters of the total time, so no idea why it ends up with all 8 characters again, and this should be a string now, but Debug.Print gives me the Type "Date" for the date, and a Double for the Time.
Use DateValue and TimeValue, they are exactly for this:
Cells(i, iAircol + 1) = DateValue(Cells(i, iAircol))
Cells(i, iAircol + 2) = TimeValue(Cells(i, iAircol))
Then apply the Format you prefer to the two date and time columns, as these will hold true DateTime values, not text.
Please, use the next function to split the string as you need:
Function splitDateTime(strTime As String) As Variant
Dim d As Date, t As Date, arrD
arrD = Split(Split(strTime, " ")(0), "-")
d = DateSerial(CLng(arrD(0)), CLng(arrD(1)), CLng(arrD(2)))
t = CDbl(CDate(Format(Split(strTime, " ")(1), "hh:mm")))
splitDateTime = Array(d, t)
End Function
It can be tested like this:
Sub testSplitDateTime()
Dim arr, ac As Range
Set ac = ActiveCell 'in the active cell should be the string to be split/converted...
arr = splitDateTime(ac.value)
ac.Offset(0, 2).EntireColumn.NumberFormat = "HH:mm"
Range(ac.Offset(0, 1), ac.Offset(0, 2)).value = arr
End Sub
Is there a way to create an array of the last 12 months (Month/Year in "mmm-yy" format) based on Month/Year in "mmm-yy" from a variable?
Use Dateadd
Sub Demo()
Dim s As String, ar, n As Integer
s = Format(Date, "mmm-yy") ' default
s = InputBox("mmm-yy", "Input mmm-yy", s)
ar = PriorYear(s)
For n = 1 To 12: Debug.Print n, ar(n): Next
End Sub
Function PriorYear(s) As Variant
Dim ar(1 To 12) As String, dt As Date, n As Integer
dt = DateValue("01-" & s)
For n = 12 To 1 Step -1
dt = DateAdd("m", -1, dt)
ar(n) = Format(dt, "mmm-yy")
Next
PriorYear = ar
End Function
Please, try the more compact version, too:
Dim arr, d As Date: d = Date 'you can choose any date you need
arr = Application.Transpose(Evaluate("TEXT(DATE(" & Year(d) - 1 & ",row(" & month(d) & ":" & month(d) + 11 & "),1),""mmm-yy"")"))
Debug.Print Join(arr, "|")
I usually post an answer if OP proves that he tried something by his own and it is good to learn that this aspect is mandatory in our community. Even explain in words what you tried. I made an exception only for the challenging sake, since the question has already been answered...
This late post demonstrates how to get the last 12 month dates via Evaluate, based on a symbolic formula syntax like
{Text(Date(StartYear,Column(StartColumn:EndColumn),1),"mmm-yyyy")}
Extra feature: The function accepts an optional argument MonthsCount changing the default value of 12 last months to any other positive value.
Public Function LastNMonths(dt As Date, Optional MonthsCount As Long = 12)
'Purpose: get 1-dim array of last 12 month dates formatted "mmm-yy")
'a) get start date
Dim StartDate As Date: StartDate = DateAdd("m", -MonthsCount + 1, dt)
Dim yrs As Long: yrs = Year(dt) - Year(StartDate)
'b) get column numbers representing months .. e.g. "J:U" or "A:L"
Dim cols As String
cols = Split(Cells(, Month(StartDate)).Address, "$")(1)
cols = cols & ":" & Split(Cells(, Month(dt) + Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates .. e.g. Text(Date(2020,Column(J:U),1),"mmm-yyyy")
LastNMonths = Evaluate("Text(Date(" & Year(StartDate) & _
",Column(" & cols & "),1),""mmm-yyyy"")")
End Function
Example call
You might want to display the resulting "flat" array based on today's date input (ending currently in Sep-2021) within the VB Editor's immediate window by a joined list
Debug.Print Join(LastNMonths(Date), "|")
returning e.g.
Oct-2020|Nov-2020|Dec-2020|Jan-2021|Feb-2021|Mar-2021|Apr-2021|May-2021|Jun-2021|Jul-2021|Aug-2021|Sep-2021
I am trying to generate a table to record articles published each month. However, the months I work with different clients vary based on the campaign length. For example, Client A is on a six month contract from March to September. Client B is on a 12 month contract starting from February.
Rather than creating a bespoke list of the relevant months each time, I want to automatically generate the list based on campaign start and finish.
Here's a screenshot to illustrate how this might look:
Below is an example of expected output from the above, what I would like to achieve:
Currently, the only month that's generated is the last one. And it goes into A6 (I would have hoped A5, but I feel like I'm trying to speak a language using Google Translate, so...).
Here's the code I'm using:
Sub CreateReport()
Dim uniqueMonths As Collection
Set uniqueMonths = New Collection
Dim dateRange As Range
Set dateRange = Range("B2:C2")
On Error Resume Next
Dim currentRange As Range
For Each currentRange In dateRange.Cells
If currentRange.Value <> "" Then
Dim tempDate As Date: tempDate = CDate(currentRange.Text)
Dim parsedDateString As String: parsedDateString = Format(tempDate, "MMM")
uniqueMonths.Add item:=parsedDateString, Key:=parsedDateString
End If
Next currentRange
On Error GoTo 0
Dim uniqueMonth As Variant
For Each uniqueMonth In uniqueMonths
Debug.Print uniqueMonth
Next uniqueMonth
Dim item As Variant, currentRow As Long
currentRow = 5
For Each item In uniqueMonths
dateRange.Cells(currentRow, 0).Value = item
currentRow = currentRow + 1
Next item
End Sub
User defined function via Evaluate
Simply enter =GetCampaignMonths(A2,B2) into cell A5.
If you don't dispose of the newer dynamic versions 2019+/MS365, it's necessary to enter a CSE (Ctrl+Shift+Enter) to finish an {array formula}:
Explanation
Basically this displays all results as dynamic (spill) range, profiting from an evaluation of a code one liner ...
e.g. Jan..Dec (12 months represented by column addresses)*
=TEXT(DATE(0,Column(A:L),1),"mmmm")
If you want to include further years, the udf simply adds the years difference (section a) multiplied by 12 to the column numbers (c.f. section b).
The evaluation of the DATE() function (c.f. section c) gets even successive years correctly, TEXT() returns the (English) months names formatted via "mmmm".
Public Function GetCampaignMonths(StartDate As Date, StopDate As Date)
'Purpose: get vertical 2-dim array of month names
'a) get years difference
Dim yrs As Long: yrs = Year(StopDate) - Year(StartDate)
'b) get column numbers representing months
Dim cols As String
cols = Split(Cells(, month(StartDate)).Address, "$")(1)
cols = cols & ":" & Split(Cells(, month(StopDate) + Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates
Dim months
months = Evaluate("Text(Date(0,Column(" & cols & "),1),""mmmm"")")
GetCampaignMonths = Application.Transpose(months)
End Function
Make an Array with the month names and then loop trough it accordting to initial month and end month:
Sub test()
Dim IniDate As Date
Dim EndDate As Date
Dim Months As Variant
Dim i As Long
Dim zz As Long
IniDate = CDate(Range("A2").Value)
EndDate = CDate(Range("b2").Value)
Months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
zz = 5
For i = Month(IniDate) - 1 To Month(EndDate) - 1 Step 1
Range("A" & zz) = Months(i)
zz = zz + 1
Next i
Erase Months
End Sub
For this code to work, both dates must be recognized as dates properly. Make sure of that or it won't work.
IMPORTANT: This will work only with dates in same year, unfortunately... I noticed that right now.
UPDATE: You can benefit from DateAdd and DateDiff to make a code so it works even in different years :)
DateAdd
function
DateDiff
Function
Sub test2()
Dim IniDate As Date
Dim EndDate As Date
Dim Months As Variant
Dim i As Long
Dim zz As Long
Dim TotalMonths As Byte
IniDate = CDate(Range("A2").Value)
EndDate = CDate(Range("b2").Value)
Months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
TotalMonths = DateDiff("m", IniDate, EndDate, vbMonday)
zz = 5
For i = 0 To TotalMonths Step 1
Range("A" & zz).Value = Months(Month(DateAdd("m", i, IniDate)) - 1)
zz = zz + 1
Next i
Erase Months
End Sub
You can also do this with functions, no VBA required:
Office 365
A5: =EOMONTH(Campaign_Start,SEQUENCE(1+DATEDIF(Campaign_Start,Campaign_End,"m")+(DAY(Campaign_End)<DAY(Campaign_Start)),,0))
and the results will SPILL down as far as needed.
Format the cells as mmm
If you do not have Office 365, then try:
=EOMONTH(Campaign_Start,-1+ROW(INDEX($A:$A,1):INDEX($A:$A,1+DATEDIF(Campaign_Start,Campaign_End,"m")+(DAY(Campaign_End)<DAY(Campaign_Start)))))
If your version of Excel does not have dynamic arrays where the results SPILL, you will need to enter the formula in the individual cells as an array, and it would require further modification.
As replay to #T.M. nice piece of code. The version using Row Evaluation:
Function GetCampaignMnths(StartDate As Date, StopDate As Date)
'Purpose: get vertical 2-dim array of month names
'b) get rows numbers representing months
Dim monthsNo As Long, rows As String
monthsNo = DateDiff("m", StartDate, StopDate, vbMonday)
rows = Month(StartDate) & ":" & monthsNo + Month(StartDate)
'c) evaluate dates
Dim months
months = Evaluate("Text(Date(0,row(" & rows & "),1),""mmmm"")")
GetCampaignMnths = months
End Function
It can be easily tested using the next sub:
Sub testGetCampaignMohths()
Dim arr
arr = GetCampaignMnths("01.03.2021", "01.08.2022") 'use here date recognized by yor localization. Or build them using DateSerial
Debug.Print Join(Application.Transpose(arr), "|")
End Sub
Assuming A2 & B2 are already dates,
Sub CreateReport()
Dim mth as Date, endmth as Date, orow as Integer
mth = worksheetfunction.eomonth(activesheet.cells(2,1).value,0)
endmth = worksheetfunction.eomonth(activesheet.cells(2,2).value,0)
orow = 5
Do
Activesheet.cells(orow,1).value = worksheetfunction.min(activesheet.cells(2,2).value,mth)
' Activesheet.cells(orow,1).numberformat = "mmm" 'uncomment for automatic formatting
orow = orow + 1
mth = worksheetfunction.eomonth(mth,1)
Loop While mth <= endmth
End Sub
This actually puts dates into your output column which can custom format as "mmm" if necessary. If you decide you actually just want text in those columns then just wrap the min(endmth,mth) in a worksheetfunction.text function with a "mmm" format.
Please, try the next code:
Sub GenerateMonthsL()
Dim sh As Worksheet, firstM As Long, lastM As Long, arrD, arrProj, i As Long, k As Long
Set sh = ActiveSheet
firstM = month(sh.Range("A2").Value2)
lastM = month(sh.Range("B2").Value2)
arrD = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Dec", ",")
ReDim arrProj(lastM - firstM + 1)
For i = firstM - 1 To lastM - 1
arrProj(k) = arrD(i): k = k + 1
Next
ReDim Preserve arrProj(k - 1)
sh.Range("A5").Resize(UBound(arrProj) + 1, 1).value = Application.Transpose(arrProj)
With sh.Range("A4:B4")
.value = Array("Months", "Articles Published")
.Font.Bold = True
.Interior.Color = 14998742
.EntireColumn.AutoFit
End With
End Sub
If you would rather avoid VBA entirely, Excel's array functions let you do this using spreadsheet formulae (if your version of Excel is recent enough).
Put this formula in Cell A5 (assuming start date in A2, and end date in B2):
=LET(mnths,1+(12*YEAR(B2)+MONTH(B2)-(12*YEAR(A2)+MONTH(A2))),s,SEQUENCE(mnths),TEXT(DATE(YEAR(A2),MONTH(A2)+(s-1),1),"mmm"))
If you have more than a year, you can amend the TEXT format string to "mmm-yy".
I'm working on a school project to compare if date1 is equal to date2 - 1 (date1 is one day earlier than date2).
date2 is located one cell below date1. This is will be placed in an if/else statement where the comparison will return a Boolean.
This is the code that I am working on,
Sub someLoop()
Dim night As Long
night = 1
Dim c As Long
Dim max_rows As Long
max_rows = UsedRange.Rows.Count
For c = 2 To max_rows
Range("A" & c).Select
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value2 - 1 Then
night = night + 1
Else
ActiveCell.Offset(0, 2).SetValue = night
night = 1
End If
Next c
End Sub
Dates in Excel can be treated just like numbers.
So, if [A1] has 28-May-14 and [A2] has 29-May-14, then you can just write the formula: =(A1=A2-1)
I would use DATEDIFF.
For example:
dateDiff("d", date2 , date1) = 1
With date2 = 28.05.2014 and date1 = 29.05.2014. d defines that you want the difference by days.
am having one Excel file it contains the data with multiple sheets. In that One column having time stamp like 21/6/12 10:33:07:AM. My system date format is "m/d/yyyy"
while converting this to Date 21/06/2012. am able to get the date but it is showing in wrong. 06-12-2021 this should be 21-06-2012. am using the below code.
Ex : 26/6/12 11:15:07:AM should be 26/06/2012
21/6/12 10:33:07:AM should be 21/06/2012
Public Sub ConvtDate()
Dim ParseDateTime As Date
Application.ScreenUpdating = False
For Each datcol In ws_Raw2.Range("I2:I65536")
x = InStr(1, datcol, " ", vbTextCompare) - 1
If x > 0 Then
ParseDateTime = DateValue(Left(datcol, x))
datcol.Value = ParseDateTime
End If
Next
Application.ScreenUpdating = True
End Sub
Please help how to get the date.
Thanks in advance.
DateValue expects a date as a string in the format set by your system.
From Excel Help:
If date is a string that includes only numbers separated by valid date separators, DateValue recognizes the order for month, day, and year according to the Short Date format you specified for your system.
Since your data is in Day Month Year and your system is Month Day Year you will need to reconstruct the parameter you pass to DateValue.
Here's a refactor of your coed, also dealing with a few other issues:
Dim all your variables (use Option Explicit to force this)
Only process rows you need to
Loop a variant array rather than a range, it much faster
Public Sub ConvtDate()
Dim ParseDateTime As Date
Dim i As Long
Dim x As Long
Dim a() As String
Dim dat As Variant
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Range(Cells(2, 9), Cells(Rows.Count, 9).End(xlUp))
dat = rng.Value
For i = 1 To UBound(dat, 1)
x = InStr(1, dat(i, 1), " ", vbTextCompare) - 1
If x > 0 Then
a = Split(Left(dat(i, 1), x), "/")
ParseDateTime = DateValue(a(1) & "/" & a(0) & "/" & a(2))
' or if you dont know the system data format use
' ParseDateTime = DateSerial(a(2), a(1), a(0))
dat(i, 1) = ParseDateTime
End If
Next
rng = dat
Application.ScreenUpdating = True
End Sub
Excel will change 26/6/12 to 26/06/2012 itself if the column formating ins date. So
ParseDateTime = Left(datcol, x)
should do it.