VBA - Date-Time String Replace/Substitute - excel

I have a column which has date and time of emails from outlook. Some dates are in format - January 2, 2020 4:15 PM, January-14-20 12:44 PM, December-24-19 20:15 PM.
I have tried to use Replace and Substitute functions, Replace does work as defined but from the string time is removed. I would like to have all dates as 2019-12-27 3:02 PM.
sub Replace()
Dim sString, searchString as String
dim i, LastCell as Long
LastCell = Range("C" & Rows.Count).End(xlUp).Row
Set searchRng = Range("C3:C" & lastCell)
For Each c In searchRng
sString = c
searchString = "-"
If InStr(1, sString, searchString, vbTextCompare) > 0 Then
i = InStr(1, sString, SearchString, vbTextCompare)
i = InStr(i + 1, sString, SearchString, vbTextCompare)
c.Offset(0, 1) = WorksheetFunction.Replace(sString, i, "19", " 2020")
End If
Next c
End Sub

A really safe way to do it without letting Excel guess:
Use a Regular Expression to parse and split the date into pieces (eg using this pattern):
And then use the DateSerial function and TimeSerial function to create a real date value:
Dim RealDateTime As Date
RealDateTime = DateSerial(2020, 2, 20) + TimeSerial(16, 50, 22)
That can be written as real date value into a cell:
Range("A1").Value = RealDateTime
And formatted how ever you like (because it is a real date value)
Range("A1").NumberFormat = "yyyy-mm-dd hh:mm AM/PM"

CDate will convert a date/time that is a string into a real date/time that can be formatted.
So code like:
For Each c In rngSrc
c.Offset(0, 1) = CDate(c)
c.Offset(0, 1).NumberFormat = "yyyy-mm-dd h:mm AM/PM"
Next c
will convert

I still think you could do this easier:
'
'
'
LastCell = Range("C" & Rows.Count).End(xlUp).Row
With Range("C3:C" & lastCell).Offset(0, 1)
.FormulaR1C1 = "=TEXT(RC[-1],""yyyy-mm-dd hh:mm AM/PM"")"
.Value = .Value
End With
NOTE: yyyy-mm-dd hh:mm AM/PM will work according to your regional settings, so if Excel is not in english, translate it. My excel is spanish, and this code would not work for me unless I type aaaa-mm-dd hh:mm AM/PM instead of yyyy-mm-dd hh:mm AM/PM
Convert all dates at once.
Range

Related

Convert text to specific date

I have the following text in cell A1
09-03-22
that's mm-dd-yyyy
the type is general but I want to Convert it into Date with the format dd.mm.yyyy
Can be in Excel or with vba....
Because if I change the type to date it always returns as 09.03.2022 or 09 March 2022 ... Excel thinks my month is my day and the other way around. But what I want is 03.09.2022
With VBA, this is one way to do it in the ActiveCell:
Sub TxtDateToDate()
Dim strDate As String
With ActiveCell
strDate = .Value
strDate = Split(strDate, ".")(1) & "/" & _
Split(strDate, ".")(0) & "/" & _
Split(strDate, ".")(2)
.Formula = .Value + 0 'shake cell format
.Formula = DateValue(strDate)
.NumberFormat = "MM.DD.YYYY"
End With
End Sub
If I correctly understood your case, it looks that there is a column having inconsistent Date/String data. The existing Date swaps the day with month and the string date starts with month followed by day.
If this is the case, please try the next code. It assumes that the column to be processed is A:A, and returns in column B:B. You can easily change the two columns:
Sub ConvertText_DateToDate()
Dim sh As Worksheet, lastR As Long, arr, arrD, arrStrD, i As Long
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A2:A" & lastR).Value2
ReDim arrD(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If IsNumeric(arr(i, 1)) Then
arrD(i, 1) = DateSerial(Year(arr(i, 1)), Day(arr(i, 1)), Month(arr(i, 1)))
Else
arrStrD = Split(arr(i, 1), "/")
arrD(i, 1) = DateSerial(CLng(arrStrD(2)), CLng(arrStrD(0)), CLng(arrStrD(1)))
End If
Next i
'format and drop the processed array content, at once:
With sh.Range("B2").Resize(UBound(arrD), 1)
.NumberFormat = "dd-mm-yyyy"
.Value2 = arrD
End With
End Sub
But, if the Date part did not swap day with month, you have to use
arrD(i, 1) = arr(i, 1)
Instead of:
arrD(i, 1) = DateSerial(Year(arr(i, 1)), Day(arr(i, 1)), Month(arr(i, 1)))

Format string to date with double digit day and month using Excel VBA

My worksheet has these formulas. Some of the values in column T are Date and some are string or general:
And its values:
I have this VBA code that loops through each cell in a column and convert the string value to a date and format the date. However, it is working perfectly fine with a double-digit month and day, but not single digits. What is the cause of problem and how can I make it to always result in double digit, i.e "01 - 02 -2021", not "1/2/2021"?
Sub Date_format()
Dim Cel As Range
Dim i As Integer
i = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
' First I applied mm - dd as the same as the work sheet
ActiveSheet.Range("T2:T" & i).NumberFormat = "mm-dd-yyyy"
For Each Cel In ActiveSheet.Range("T2:T" & i)
If Not Cel.Value = "n/a" Then
' Then I applied dd - mm to swap the day and month
Cel.Value = Format(DateValue(Cel.Value), "dd - mm - yyyy")
End If
Next
End Sub
Once I applied .NumberFormat = "dd-mm-yyyy" to the range, my other formula =DAYS(TODAY(),T2) that calculate days, are not working any more on most cells as shown in this picture:
Please, try transforming this part:
If Not Cel.Value = "n/a" Then
Cel.Value = Format(DateValue(Cel.Value), "dd - mm - yyyy")
End If
as:
If Not Cel.Value = "n/a" Then
Cel.NumberFormat = "dd - mm - yyyy"
Cel.Value = Format(DateValue(Cel.Value), "dd - mm - yyyy")
End If
As I mentioned in the comments above, add
.Range("T2:T" & i).NumberFormat = "dd - mm - yyyy"
before the FOR loop.
Here is another way to achieve what you want without using loops.
Code:
Option Explicit
Sub Date_format()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Last row in Col T
lRow = .Range("T" & .Rows.Count).End(xlUp).Row
With .Range("T2:T" & lRow)
.NumberFormat = "dd - mm - yyyy"
.Value = ws.Evaluate("index(IF(" & .Address & _
"<>""n/a"",DATEVALUE(" & .Address & "),""n/a""),)")
End With
End With
End Sub
Screenshot:
Explanation:
This approach uses EVALUATE with INDEX, IF and DATEVALUE to do the conversion without using any loops. For explanation on how it works, please see Convert an entire range to uppercase without looping through all the cells

European Date format in Userform

I have a Userform that populates Textboxes with dates from a worksheet. The idea is to be able to edit the dates and save them back to the worksheet. The problem is the dates show up in American format, not European. I understand that I need to use code to force the date to show as European. So I have tried using this code
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
I then have a function to populate the form, where I want the correct date format to show
Sub PopulateForm()
Me.Location.Value = rngFound(1, 0).Value
Me.ID.Value = rngFound(1, 1).Value
Me.FirstName.Value = rngFound(1, 2).Value
Me.LastName.Value = rngFound(1, 3).Value
Me.Grade = rngFound(1, 4).Value
Me.ARLFam = rngFound(1, 8).Value
Me.ARLEvac = rngFound(1, 11).Value
Me.HRDFam = rngFound(1, 16).Value
Me.HRDEvac = rngFound(1, 19).Value
Me.CRDFam = rngFound(1, 24).Value
Me.CRDEvac = rngFound(1, 27).Value
Me.RSQFam = rngFound(1, 32).Value
Me.RSQEvac = rngFound(1, 35).Value
Me.COVFam = rngFound(1, 40).Value
Me.COVEvac = rngFound(1, 43).Value
Me.LSQFam = rngFound(1, 48).Value
Me.LSQEvac = rngFound(1, 51).Value
Me.HPCFam = rngFound(1, 56).Value
Me.HPCTrackFam = rngFound(1, 63).Value
Me.HPCEvac = rngFound(1, 59).Value
Me.KNBFam = rngFound(1, 67).Value
Me.KNBEvac = rngFound(1, 70).Value
End Sub
I haven't figured out where to place LValue in the sub routine for it to change the dates to the correct format. Am I on the right track? Or am I barking up the wrong tree?
Next, when I have changed the dates and save the changes to the worksheet, I encounter a new problem. The cells the dates go into are set up as dates, and other cells have formulas working off the information provided by the date cells. When I save the dates from the Userform, they show up in the correct cells, but all the other cells reading from the date cell now have the #Value error showing. This is the code used to save the new dates to the worksheet.
Private Sub EnterButton_Click()
Dim LR As Long
Dim replace As Long
Dim response As Long
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
If Me.ID.Value = "" Then
MsgBox "You have not entered an ID."
Me.ID.SetFocus
Exit Sub
End If
FindRecord (Val(Me.ID))
If Not rngFound Is Nothing Then
replace = MsgBox("This record already exists in this Database." & vbNewLine _
& "Replace?", vbYesNo)
If replace = vbYes Then
LR = rngFound.Row
Else
ClearForm
Me.ID.SetFocus
Exit Sub
End If
Else
LR = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
With ws
.Cells(LR, 1).Value = Me.Location
.Cells(LR, 2).Value = Val(Me.ID)
.Cells(LR, 3).Value = Me.FirstName
.Cells(LR, 4).Value = Me.LastName
.Cells(LR, 5).Value = Me.Grade
.Cells(LR, 9).Value = Me.ARLFam
.Cells(LR, 12).Value = Me.ARLEvac
.Cells(LR, 17).Value = Me.HRDFam
.Cells(LR, 20).Value = Me.HRDEvac
.Cells(LR, 25).Value = Me.CRDFam
.Cells(LR, 28).Value = Me.CRDEvac
.Cells(LR, 33).Value = Me.RSQFam
.Cells(LR, 36).Value = Me.RSQEvac
.Cells(LR, 41).Value = Me.COVFam
.Cells(LR, 44).Value = Me.COVEvac
.Cells(LR, 49).Value = Me.LSQFam
.Cells(LR, 52).Value = Me.LSQEvac
.Cells(LR, 57).Value = Me.HPCFam
.Cells(LR, 64).Value = Me.HPCTrackFam
.Cells(LR, 60).Value = Me.HPCEvac
.Cells(LR, 68).Value = Me.KNBFam
.Cells(LR, 71).Value = Me.KNBEvac
End With
If replace = vbYes Then
MsgBox "The existing record on " & ws.Name & " row# " & rngFound.Row & " was overwitten"
Else
MsgBox "The record was written to " & ws.Name & " row# " & LR
End If
response = MsgBox("Do you want to enter another record?", _
vbYesNo)
If response = vbYes Then
ClearForm
Me.ID.SetFocus
Else
Unload Me
End If
End Sub
Is it because the date has been saved as text instead of a date? If so, how do I get it to save as a European date?
The following assumes that you have real dates in Excel (you can prove this for example by formatting a cell containing a date as General: It should display a number).
Background: dates are stored internally as numbers, the integer part
gives the Date-part, counting the number of days starting from 1.
January 1900. The fraction part is representing the time, 1/3 would be
8am (a third of the day)
A textbox in VBA contains always a String. When you want to write a date into the textbox and use code like tbStartDate = ActiveSheet.Cells("B2") and B2 contains a date, you are asking VBA to convert the date into a string. VBA will do so, but it has it's own rules for that and so you end up with a string that looks like an US date. Basically, you should always avoid that VBA does an automatic conversion for you. Instead, use a function for that: Format it the right function to convert a Date or a number into a string, you use it already correctly in the first 2 statements. To write the date into the textbox, you now write
tbStartDate = Format(ActiveSheet.Cells("B2"), "dd/mm/YYYY")
Now comes the tricky part: The user may change the date and you want to write it back to the cell. Again, you shouldn't let Excel do the conversion implicitly. The problem is that with a normal text box you cannot prevent that the user enters rubbish stuff (you might read Formatting MM/DD/YYYY dates in textbox in VBA).
But let's assume your user enters the date in the "correct" form: How do you convert a string into a date?
You often see the answer to use CDate that converts a string into a date, respecting the locale setting of the system. Fine, as long as all users have the same settings. But if you might have a user coming with a Laptop freshly imported from the US or that comes from any other part of the world, you have the same problem again: VBA will convert the date with wrong assumptions (eg changing the day- and month part).
Therefore I usually use a small custom function that splits the string and use the parts as parameters into another VBA function DateSerial. It will return 0 (=1.1.1900) if the input is complete nonsense, but doesn't check all invalid possibilities. A 13 as input is happily accepted (DateSerial, btw, accepts this also).
Function StrToDate(s As String) As Date
' Assumes input as dd/mm/yyyy or dd.mm.yyyy
Dim dateParts() As String
dateParts = Split(Replace(s, ".", "/"), "/") ' Will work with "." and "/"
If UBound(dateParts) <> 2 Then Exit Function
Dim yyyy As Long, mm As Long, dd As Long
dd = Val(dateParts(0))
mm = Val(dateParts(1))
yyyy = Val(dateParts(2))
If dd = 0 Or mm = 0 Or yyyy = 0 Then Exit Function
StrToDate = DateSerial(yyyy, mm, dd)
End Function
Now, writing the input back to the cell could be like
dim d as Date
d = StrToDate(tbStartdate)
if d > 0 then ActiveSheet.cells(B2) = d
you surely can change the current forat into an european one and here is some examples of how you can uses it :
Sub dates_et_heures()
'Now renvoie la date et l'heure en cours (07.02.2018 09:09:02)
date_test = Now()
'Renvoie : 07.02.18
Range("A1") = Format(date_test, "dd.mm.yy")
'Renvoie : mardi 7 février 2018
Range("A2") = Format(date_test, "dddd d mmmm yyyy")
'Renvoie : Mardi 7 Février 2018
Range("A3") = WorksheetFunction.Proper(Format(date_test, "dddd d mmmm yyyy"))
'Renvoie : mar. 07
Range("A4") = Format(date_test, "ddd dd")
'Renvoie : MAR 07
Range("A5") = "'" & Replace(UCase(Format(date_test, "ddd dd")), ".", "")
'Renvoie : FÉVRIER 2018
Range("A6") = UCase(Format(date_test, "mmmm yyyy"))
'Renvoie : 07.02.2018 09:09
Range("A7") = Format(date_test, "dd.mm.yyyy hh:mm")
'Renvoie : Le 7 février à 9h09'02''
Range("A8") = Format(date_test, "Le d mmmm à h\hmm'ss''")
'Renvoie : 9H09
Range("A9") = Format(date_test, "h\Hmm")
End Sub
I don't have the answer for the second part but i hope this could help too

How can get Month Name and year from the existing data

This the data I have.
I just want its month name and year.
For example 201804: Apr 2018
Try this UDF
Sub Test()
Debug.Print FormatDate("201804")
End Sub
Function FormatDate(sInput As String)
sInput = "1/" & Right(sInput, 2) & "/" & Left(sInput, 4)
FormatDate = Format(CDate(sInput), "mmm yyyy")
End Function
Try
Sub test()
Dim vDB
Dim i As Long
Dim s As String, y As String, m As String
vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
For i = 2 To UBound(vDB, 1)
s = vDB(i, 1)
y = Left(s, 4)
m = Right(s, 2)
vDB(i, 1) = Format(DateSerial(y, m, 1), "mmm yyyy")
Next i
With Range("b1").Resize(UBound(vDB, 1), 1)
.NumberFormatLocal = "#"
.Value = vDB
End With
End Sub
Here is the worksheet formula, converting the date in A1. Copy the formula down as required.
=DATE(LEFT(A1,4),RIGHT(A1,2),1)
The result is a proper date set for the first day of the month, in this case April 1, 2018. The format in which this result is displayed depends entirely upon your system settings. However, you can over-ride the system by setting a custom date format in Format > Cells > Numbers > Custom*. Set Type as mmm yyyy to display Apr 2018 in the cell.

Issue converting dd.mm.yyyy to UK date format using VBA

I have dates in the following format :-
01.01.2019
01.02.2019
01.03.2019
14.03.2019
and I would like these in UK date format of dd/mm/yyyy, using VBA conversion.
I attempted to use a REPLACE, changing "." to "/", but this outputs the dates as :-
01/01/2019
02/01/2019
03/01/2019
14/03/2019
Is there a way to overcome this?
The below code loop column A & convert the date in column B. Try:
Option Explicit
Sub test()
Dim Year As String, Month As String, Day As String, WholeString As String
Dim i As Long, Lastrow As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
WholeString = .Range("A" & i).Value
Year = Right(WholeString, 4)
Month = Mid(WholeString, 4, 2)
Day = Left(WholeString, 2)
With .Range("B" & i)
.Value = CDate(Day & "/" & Month & "/" & Year)
.NumberFormat = "dd/mm/yyyy"
End With
Next i
End With
End Sub
What does this do for you? I'm curious if it would return dd/mm/yyyy for you:
With ActiveSheet.UsedRange.Columns("A").Cells
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, xlDMYFormat)
.NumberFormat = "dd/mm/yyyy"
End With

Resources