I am attempting to write a Marco to select the highlighted cell in the image attached (B11), locate the highlighted colon (20th character from the left) and replace it with a dot and loop this to do all 2500 rows in "B"
I am new to writing macros an would appreciate any help you can give me
Small showcase of how would you search for the last occurrence of ":" in Range("B11") and replace it with a "."
Sub replaceTest()
Dim val As String
Dim pos As Long
Dim rng As Range
Set rng = Range("B11")
val = rng.Value
pos = InStrRev(val, ":")
If pos > 0 Then
Mid$(val, pos, 1) = "."
rng.Value = val
End If
Set rng = Nothing
End Sub
Since your date times 18/10/2022 11:42:10:358 look to be text. I recommend to convert them into a numeric date time (so you can calculate with it and use comparisons which is greater or smaller).
Therefore you need to split the text up into its parts and turn it into a real numeric date using DateSerial and TimeSerial. Finally you need to calculate the milliseconds and add them.
Then you can use .NumberFormat = "DD\/MM\/YYYY hh:mm:ss.000" to format it as you like.
Public Function StringToDateTime(ByVal InputString As String) As Double
Dim InputDateTime() As String ' Split into DD/MM/YYYY and hh:mm:ss:000
InputDateTime = Split(InputString, " ")
Dim InputDate() As String ' Split into DD and MM and YYYY
InputDate = Split(InputDateTime(0), "/")
Dim InputTime() As String ' Split into hh and mm and ss and 000
InputTime = Split(InputDateTime(1), ":")
Dim RetVal As Double
RetVal = DateSerial(InputDate(2), InputDate(1), InputDate(0)) + TimeSerial(InputTime(0), InputTime(1), InputTime(2)) + InputTime(3) / 24 / 60 / 60 / 1000
StringToDateTime = RetVal
End Function
Public Sub Example()
Dim Cell As Range
For Each Cell In Range("A1:A5")
Cell.Value2 = StringToDateTime(Cell.Value2)
Cell.NumberFormat = "DD\/MM\/YYYY hh:mm:ss.000"
Next Cell
End Sub
I also need to apply Match function in VBA, and the Arg 1 also has to be Date. The Array (Arg 2) I defined in the "Name Manager" (Tab Formula of Excel). I need to use the Name Manager since I have several array/ table reference based on the type of currency. For example, if the currency is USD, the reference table is USDREF which I defined as Range("B21:B36"). For the other currency, ex. JPY, I use array/ table reference JPYREF which is defined as JPYREF from Range("B36:B50"). It applies for other currencies. Here's my code :
Dim Original As Workbook
Dim SRate As Worksheet
Dim ccy As String
Dim i, j, k, l, Rank1, Rank2, Rate1, Rate2 As Integer
Dim srow, erow, x As Long
Dim DateFCYIDR, Date1, Date2 As Date
Sub fcyidr()
Set Original = ThisWorkbook
Set SRate = Original.Sheets("Rate")
SRate.Activate
Range("A36").Select
ccy = ActiveCell.Value
While ActiveCell.Value <> ""
For i = 1 To 15
If i = 1 Or i = 15 Then
j = ActiveCell.Row
ActiveCell.Offset(0, 8) = "=+$G$" & j - 15 & "/G" & j
ActiveCell.Offset(1, 0).Select
Else
DateFCYIDR = ActiveCell.Offset(0, 7).Value
Rank1 = WorksheetFunction.Match(CLng(DateFCYIDR), USDREF, 0)
End If
Next i
Wend
where USDREF is defined in Name Manager. But it didn't work.
How do I solved the problem?
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
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 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)