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
Related
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 basically have a date entered in cell N3 and a column (column I) that contains date sorted by date. I am trying to write a code that asks the user to input a date at first. Then the program would look for that date in the column I and delete ALL the rows after the row in which the match was found.
My code is somehow working, but here is my problem. Only a part of the rows under the wanted row are being deleted and not all of them. I was thinking that could be an issue with the for-loop or the counter?
Please let me know if you could help :)
Sub DeleteAllRowsPaymentTooFar()
Worksheets("Master").Activate
Dim date_max As Date
date_max = InputBox("What is the maximum date to filter? ")
Range("N3").Value = date_max
Range("N3").NumberFormat = ("ddddd, mmmmmmmmm d, yyyy")
Dim i As Long
i = Range("A4").End(xlDown).Row
Dim result As Integer
Dim str1 As String, str2 As String
Dim counter As Long
str1 = Cells(3, 14).Text
counter = 4
Do While counter <= i
str2 = Cells(counter, 9).Text
result = StrComp(str1, str2, vbTextCompare)
If result <> 0 Then
MsgBox ("The date is not yet reached.")
Else
For K = counter To i
Worksheets("Master").Rows(K).EntireRow.Delete
Next
End If
counter = counter + 1
Loop
End Sub
I expect to remove all the rows under the row where the match was found.
This may help you:
For i=LastPoint To FirstPoint Step-1
Worksheets("Master").Rows(i).EntireRow.Delete
Next i
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)
In a program that I'm trying to write now I take two columns of numbers and perform calculations on them. I don't know where these two columns are located until the user tells me (they input the column value in a cell in the workbook that my code is located in).
For example, if the user inputted "A" and "B" as the columns where all the information is in I can perform calculations based on those values. Likewise if they wanted to analyze another worksheet (or workbook) and the columns are in "F" and "G" they could input those. The problem is that I'm asking the user to input those two columns as well as four others (the last four are the result columns). I did this in hopes that I would be able to make this flexible, but now inflexibility is acceptable.
My question is, if I'm given a value of where some information will be (let's say "F") how can I figure out what the column will be after or before that inputted value. So if I'm only given "F" I'll be able to create a variable to hold the "G" column.
Below are examples of how the variables worked before I needed to do this new problem:
Dim first_Column As String
Dim second_Column As String
Dim third_Column As String
first_Column = Range("B2").Text
second_Column = Range("B3").Text
third_Column = Range("B4").Text
Here the cells B2 - B4 are where the user inputs the values. Generally I want to be able to not have the B3 and B4 anymore. I feel like the Offset(0,1) might be able to help somehow but so far I've been unable to implement it correctly.
Thank you,
Jesse Smothermon
Here are two functions that will help you dealing with columns > "Z". They convert the textual form of a column to a column index (as a Long value) and vice versa:
Function ColTextToInt(ByVal col As String) As Long
Dim c1 As String, c2 As String
col = UCase(col) 'Make sure we are dealing with "A", not with "a"
If Len(col) = 1 Then 'if "A" to "Z" is given, there is just one letter to decode
ColTextToInt = Asc(col) - Asc("A") + 1
ElseIf Len(col) = 2 Then
c1 = Left(col, 1) ' two letter columns: split to left and right letter
c2 = Right(col, 1)
' calculate the column indexes from both letters
ColTextToInt = (Asc(c1) - Asc("A") + 1) * 26 + (Asc(c2) - Asc("A") + 1)
Else
ColTextToInt = 0
End If
End Function
Function ColIntToText(ByVal col As Long) As String
Dim i1 As Long, i2 As Long
i1 = (col - 1) \ 26 ' col - 1 =i1*26+i2 : this calculates i1 and i2 from col
i2 = (col - 1) Mod 26
ColIntToText = Chr(Asc("A") + i2) ' if i1 is 0, this is the column from "A" to "Z"
If i1 > 0 Then 'in this case, i1 represents the first letter of the two-letter columns
ColIntToText = Chr(Asc("A") + i1 - 1) & ColIntToText ' add the first letter to the result
End If
End Function
Now your problem can be solved easily, for example
newColumn = ColIntToText(ColTextToInt(oldColumn)+1)
EDITED accordingly to the remark of mwolfe02:
Of course, if you are not interested in the column names, but just want to get a range object of a specific cell in a given row right beneath a column given by the user, this code is "overkill". In this case, a simple
Dim r as Range
Dim row as long, oldColumn as String
' ... init row and oldColumn here ...
Set r = mysheet.Range(oldColumn & row).Offset(0,1)
' now use r to manipulate the cell right to the original cell
will do it.
You were on the right track with Offset. Here is a test function that shows a couple different approaches to take with it:
Sub test()
Dim first_Column As String
Dim second_Column As String
Dim third_Column As String
Dim r As Range
first_Column = Range("B2").Text
second_Column = Range("B2").Offset(1, 0).Text
third_Column = Range("B2").Offset(2, 0).Text
Debug.Print first_Column, second_Column, third_Column
Set r = Range("B2")
first_Column = r.Text
Set r = r.Offset(1, 0)
second_Column = r.Text
Set r = r.Offset(1, 0)
third_Column = r.Text
Debug.Print first_Column, second_Column, third_Column
End Sub
UPDATE: After re-reading your question I realize you were trying to do offsets based on a user-entered column letter. #rskar's answer will shift the column letter, but it will be a lot easier to work with the column number in code. For example:
Sub test()
Dim first_Col As Integer, second_Col As Integer
first_Col = Cells(, Range("B2").Text).Column
second_Col = first_Col + 1
Cells.Columns(first_Col).Font.Bold = True
Cells.Columns(second_Col).Font.Italic = True
End Sub
There are a few syntactical problems with #rskar's answer. However, it was helpful in producing a function that grabs a column "letter", based on an input column "letter" and a desired offset to the right:
Public Function GetNextCol(TheCol As String, OffsetRight As Integer) As String
Dim TempCol1 As String
Dim TempCol2 As String
TempCol1 = Range(TheCol & "1").Address
TempCol2 = Range(TempCol1).Offset(0, OffsetRight).Address(0, 0, xlA1)
GetNextCol = Left(TempCol2, Len(TempCol2) - 1)
End Function
In light of the comments of others (and they all raised valid points), here is a much better solution to the problem, using Offset and Address:
Dim first_Column As String
Dim second_Column As String
Dim p As Integer
first_Column = Range("B2").Text
second_Column = _
Range(first_Column + ":" + first_Column).Offset(0, 1).Address(0, 0, xlA1)
p = InStr(second_Column, ":")
second_Column = Left(second_Column, p - 1)
The above should work for any valid column name, "Z" and "AA" etc. included.
Make use of the Asc() and Chr() functions in VBA, like so:
Dim first_Column As String
Dim second_Column As String
first_Column = Range("B2").Text
second_Column = Chr(Asc(first_Column) + 1)
The Asc(s) function returns the ASCII code (in integer, usually between 0 and 255) of the first character of a string "s".
The Chr(c) function returns a string containing the character which corresponds to the given code "c".
Upper case letters (A thru Z) are ASCII codes 65 thru 90. Just google ASCII for more detail.
NOTE: The above code will be fine so long as the first_Column is between "A" and "Y"; for columns "AA" etc., it will take a little more work, but Asc() and Chr() will still be the ticket to coding for that.