I have vba function to split date/time on my worksheet
but when it find 0:00AM it will stop and I don't know how to fix this
code
Function extractDateTime(strTime As Date) As Variant
Dim arrD, d As String, t As Date
arrD = Split(strTime, " ")
d = arrD(0)
t = CDate(arrD(1) & " " & arrD(2))
extractDateTime = Array(d, t)
End Function
pic when it find date/time at 12:00:00 AM
function not return value arrD(1) and arrD(2)
cell value
pic when function normally working
Always handle date/time as Date, not text, not numbers, no exceptions. So:
Public Function ExtractDateTime(Value As Date) As Variant
Dim d As Date
Dim t As Date
d = DateValue(Value)
t = TimeValue(Value)
ExtractDateTime = Array(d, t)
End Function
Parsing the Date for spaces is not a great way to go about it.
Instead, you can use Format to just get the pieces you want.
Function extractDateTime(dt As Date) As Variant
Dim d As String, t As String
d = Format(dt, "dd/mm/yyyy")
t = Format(dt, "hh:mm:ss AMPM")
extractDateTime = Array(d, t)
Debug.Print d
Debug.Print t
Debug.Print Format(dt, "mmm dd, yyyy")
Debug.Print Format(dt, "mmmm")
Debug.Print WeekdayName(Weekday(dt))
End Function
Kinda seems like a waste of a function tho when you can just do this:
Result = Array(Format(dt, "dd/mm/yyyy"), Format(dt, "hh:mm:ss AMPM"))
Related
In consequence of a new installation of windows (different language) some log files now have a different DateTime format.
To make my Excel/VBA scripts work again I have to convert DateTime strings to the old (German) time format of constant length.
To make it clear: I want to manipulate a string (not getting another datatype).
Problematic Format => Wanted Format
"12/28/2019 9:37:49 PM" => "28.12.2019 21:37:49"
"1/2/2020 10:15:20 AM" => "02.01.2020 10:15:20"
"2/1/2020 7:10:15 AM" => "01.02.2020 07:10:15"
"2/13/2020 7:10:15 AM" => "13.02.2020 07:10:15"
One problem I face is that the "Problematic format" has a variable string length. That means I am not able to extract specific positions inside this string using LEFT / MID / RIGHT.
Is there any easy possibility to convert this string into the old format without loops?
The following Code is not working because of a strange/inconsistent behavior of Excel:
ProblematicFormat$ = "2/1/2020 7:10:15 AM"
MyDate = CDate(ProblematicFormat$)
NewDateTime$ = Format(MyDate, "dd.MM.yyyy H:nn:ss")
MsgBox NewDateTime$
The result of that code mixes up day and month:
"2/1/2020 7:10:15 AM" => "02.01.2020 07:10:15" (wrong)
"2/13/2020 7:10:15 AM" => "13.02.2020 07:10:15" (correct)
Being a matter of string manipulation, try this code, please:
Sub testDateFormatLocale()
Dim ProblematicFormat$, replacement$, toReplace$, MyDate As Date, NewDateTime$, CorrectDateTime$
'Debug.Print Now, Format(Now, "dd\/mm\/yyyy hh:nn:ss")
ProblematicFormat$ = "2/13/2020 7:10:15 AM"
MyDate = CDate(ProblematicFormat$) 'm/dd/yyyy
NewDateTime$ = Format(MyDate, "dd.MM.yyyy H:nn:ss")
Debug.Print NewDateTime$
replacement = Split(NewDateTime, ".", 3)(1) & "." & Split(NewDateTime, ".", 3)(0)
toReplace = Split(NewDateTime, ".", 3)(0) & "." & Split(NewDateTime, ".", 3)(1)
CorrectDateTime$ = Replace(NewDateTime$, toReplace, replacement)
Debug.Print CorrectDateTime$
End Sub
You can apply the above solution only for German localization. It can be done using:
Debug.Print Application.International(xlCountrySetting)
The solution is in the region and language setting. In the formats tab, change the format to US (mm/dd/yyyy). In case you do not want to change regional settings then you will have to handle the above date using Split/Dateserial and then you will get what you want. Something like this...
Option Explicit
Sub Sample()
Dim oldDateString As String
Dim newDateString As String
Dim d As Integer
Dim m As Integer
Dim y As Integer
Dim MyDate As Date
oldDateString = "2/1/2020 7:10:15 AM"
oldDateString = Split(oldDateString)(0)
d = Val(Split(oldDateString, "/")(1))
m = Val(Split(oldDateString, "/")(0))
y = Val(Split(oldDateString, "/")(2))
MyDate = DateSerial(y, m, d)
Debug.Print MyDate
newDateString = Format(MyDate, "dd.MM.yyyy H:nn:ss")
Debug.Print newDateString
End Sub
Or you can use this? This checks the regional settigns and then decides what to do...
Private Declare Function GetLocaleInfo Lib "kernel32" Alias _
"GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, _
ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SSHORTDATE = &H1F
Private Sub Sample()
Dim LocaleValue As String
Dim RetValue As Long
LocaleValue = Space(255)
RetValue = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, _
LocaleValue, Len(LocaleValue))
'~~> Get short date format
LocaleValue = Ucase(Trim(Left(LocaleValue, RetValue - 1)))
If Left(LocaleValue, 1) = "M" Then 'M/d/yyyy ???
'~~> Use your original code
ElseIf Left(LocaleValue, 1) = "D" Then
'~~> Use the code that I gave
End If
End Sub
Note: There are different formats that you may come across. The above code will help you handle all those formats, with a little tweak of course.
You can use this function which "eats" even quite weird US formatted strings:
' Converts a US formatted date/time string to a date value.
'
' Examples:
' 7/6/2016 7:00 PM -> 2016-07-06 19:00:00
' 7/6 7:00 PM -> 2018-07-06 19:00:00 ' Current year is 2018.
' 7/6/46 7:00 PM -> 1946-07-06 19:00:00
' 8/9-1982 9:33 -> 1982-08-09 09:33:00
' 2/29 14:21:56 -> 2039-02-01 14:21:56 ' Month/year.
' 2/39 14:21:56 -> 1939-02-01 14:21:56 ' Month/year.
' 7/6/46 7 -> 1946-07-06 00:00:00 ' Cannot read time.
' 7:32 -> 1899-12-30 07:32:00 ' Time value only.
' 7:32 PM -> 1899-12-30 19:32:00 ' Time value only.
' 7.32 PM -> 1899-12-30 19:32:00 ' Time value only.
' 14:21:56 -> 1899-12-30 14:21:56 ' Time value only.
'
' 2018-03-31. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function CDateUs( _
ByVal Expression As String) _
As Date
Const PartSeparator As String = " "
Const DateSeparator As String = "/"
Const DashSeparator As String = "-"
Const MaxPartCount As Integer = 2
Dim Parts As Variant
Dim DateParts As Variant
Dim DatePart As Date
Dim TimePart As Date
Dim Result As Date
' Split expression into maximum two parts.
Parts = Split(Expression, PartSeparator, MaxPartCount)
If IsDate(Parts(0)) Then
' A date or time part is found.
' Replace dashes with slashes.
Parts(0) = Replace(Parts(0), DashSeparator, DateSeparator)
If InStr(1, Parts(0), DateSeparator) > 1 Then
' A date part is found.
DateParts = Split(Parts(0), DateSeparator)
If UBound(DateParts) = 2 Then
' The date includes year.
DatePart = DateSerial(DateParts(2), DateParts(0), DateParts(1))
Else
If IsDate(CStr(Year(Date)) & DateSeparator & Join(DateParts, DateSeparator)) Then
' Use current year.
DatePart = DateSerial(Year(Date), DateParts(0), DateParts(1))
Else
' Expression contains month/year.
DatePart = CDate(Join(DateParts, DateSeparator))
End If
End If
If UBound(Parts) = 1 Then
If IsDate(Parts(1)) Then
' A time part is found.
TimePart = CDate(Parts(1))
End If
End If
Else
' A time part it must be.
' Concatenate an AM/PM part if present.
TimePart = CDate(Join(Parts, PartSeparator))
End If
End If
Result = DatePart + TimePart
CDateUs = Result
End Function
Then apply your format, for example:
? Format(CDateUS("1/2/2020 10:15:20 AM"), "dd.mm.yyyy hh:nn:ss")
02.01.2020 10:15:20
I have a date in mm/dd/yyyy format from a textbox in a userform, and I want to get each value mm, dd, and yyyy to a number. (Example, 10/12/2020 would become 2020-10-12)
Here is my code so far, which gets the month part finished.
Dim DateDay As String, DateMonth As String, DateYear As String
Dim firstslash As Integer, secondslash As Integer
firstslash = InStr(TextBox3, "/")
DateMonth = Left(TextBox3, firstslash - 1)
If Len(DateMonth) = 1 Then
DateMonth = "0" & DateMonth
End If
'code for day and year
MsgBox("Date =" & DateYear & "-" & DateMonth & "-" & DateDay)
How can I add to this so it can get the day and year part as well?
The trick is to be sure that you are dealing with a date, that is a large integer (43861 for today). Therefore you should convert whatever is in the textbox to an integer representing a date. That true date you can then present in any format you want. The code below does exactly that.
Private Sub CallExtractDate()
Dim Dat As Date
Dat = ExtractDate("01/31/2020")
MsgBox Format(Dat, "yyyy-mm-dd") & vbCr & _
Format(Dat, "ddd, dd mmm, yyyy") & vbCr & _
Format(Dat, "dddd")
End Sub
Function ExtractDate(ByVal TxtDate As String) As Date
Dim Sp() As String
If IsDate(TxtDate) Then
ExtractDate = CDate(TxtDate)
Else
Sp = Split(TxtDate, "/")
On Error Resume Next
ExtractDate = DateSerial(Int(Sp(2)), Int(Sp(0)), Int(Sp(1)))
End If
End Function
In your project you would probably use the function with a call like this.
Dat = ExtractDate(TextBox1.Value)
I need to turn content in a spreadsheet column from text to a date.
The cell format is text and the inputters were instructed to input a date as "ddmmyyyy".
Accidents happened and I found some content that would not parse as a date, including entries like "Unknown".
So I used a variable declared as a date and wrote an error handler to deal with content that would not parse.
Now for the bit I cannot work out.
If the date was 3rd March 2000 and someone input that as "03332000" that will not parse because "33" cannot be a month or a day; it is caught by the error handler as I wanted.
But if it was input as "03132000" I can't think of a way of preventing VBA converting that to a valid date as "13/03/2000".
Declaring a format for the date variable will not prevent VBA parsing the date.
I can write something that tests number range of the day and month part of the string but that is extra lines of code and I was hoping to do it just by the error handler.
I'd approach it a little differently and let Excel do the work.
Public Function ValidateDate(ByVal strDate As String) As Boolean
Dim intDay As Integer, intMonth As Integer, intYear As Integer, dtDate As Date
ValidateDate = True
On Error GoTo IsInValid
If Len(strDate) <> 8 Then GoTo IsInValid
If Not IsNumeric(strDate) Then GoTo IsInValid
intDay = Left(strDate, 2)
intMonth = Mid(strDate, 3, 2)
intYear = Right(strDate, 4)
dtDate = DateSerial(intYear, intMonth, intDay)
If DatePart("d", dtDate) <> intDay Then GoTo IsInValid
If DatePart("m", dtDate) <> intMonth Then GoTo IsInValid
If DatePart("yyyy", dtDate) <> intYear Then GoTo IsInValid
Exit Function
IsInValid:
ValidateDate = False
End Function
... this will ensure that anything related to leap years etc. will still work correctly and it will ensure that all entries are validated correctly.
If you place:
03332000
in cell A1 and run:
Sub CheckDate()
Dim s As String, d As Date
s = Range("A1").Text
d = DateSerial(CInt(Right(s, 4)), CInt(Mid(s, 3, 2)), CInt(Left(s, 2)))
MsgBox s & vbCrLf & d
End Sub
You will get:
So even though a valid month can only be in the range [1-12], Excel is trying to "help" you by interpreting the 33 as a projection of future date. For example, if the month was entered as 13, Excel will treat it as December of the following year!
You can't rely on error-handling for this. You need checks like:
Sub CheckDate2()
Dim s As String, d As Date
Dim dd As Integer, mm As Integer, yr As Integer
s = Range("A1").Text
yr = CInt(Right(s, 4))
mm = CInt(Mid(s, 3, 2))
dd = CInt(Left(s, 2))
If yr = 0 Or yr < 1900 Then
MsgBox "year is bad"
Exit Sub
End If
If dd = o Or dd > 31 Then
MsgBox "day is bad"
Exit Sub
End If
If mm = 0 Or mm > 12 Then
MsgBox "month is bad"
Exit Sub
End If
d = DateSerial(yr, mm, dd)
MsgBox s & vbCrLf & d
End Sub
You can also do other checks like looking at the length of the field, etc.
I am fairly new at VBA and this seems like an easy task. I am just trying to get the current date substituting the current month for the previous one and a day constant as 21 so the result will have to be yyyy - (m-1) - 21
so far I had a couple of ideas and they work partially
Sub Test_Date()
Dim x As String
Dim p As String
p = Format(Date, "mm") - 1
x = Format(Date, "yyyy-" p "-21")
End Sub
if I MsgBx "p" comesback as what I want but, I dont know the correct syntax to concatenate them into one string
also
Sub Test_Date()
Dim x As String
x = Format(Date, "yyyy-(Format(Date, "mm") - 1)-21")
End Sub
You could also try this:
Function LastMonth() As Date
Dim d As Date
d = DateAdd("m", -1, Date)
LastMonth = DateSerial(Year(d), Month(d), 21)
End Function
Edit:
Format the returned date as needed:
Sub Test()
MsgBox Format(LastMonth, "yyyy-mm-dd")
End Sub
You could use DateSerial.
This accepts a year, month and day as its input and kicks out the date based on that.
So, DateSerial(2017,9,22) will give todays date.
To get the 21st of last month you'd use
DateSerial(Year(Date), Month(Date) - 1, 21)
Year(Date) returns 2017, Month(Date) returns 9.
Use the dateadd function (https://www.techonthenet.com/excel/formulas/dateadd.php):
DateAdd( interval, number, date )
or
DateAdd("m", 5, "22/11/2003")
Try
Sub Test_Date()
Dim d As Date
d = "22-09-2017"
d = DateSerial(Year(d), Month(d) - 1, 21)
End Sub
I am trying to get the Date as a string formatted yyyy-mm-dd.
I have tried various things with strange results:
Dim mydate As String
mydate = Date
mydate = Year(Date)
mydate = Month(Date)
mydate = Day(Date)
The first one gives 11/02/ without the year.
I can try to concatenate the data but:
The second gives the year OK
However the third gives month as 2 instead of 02
Similar for fourth.
Any clarification or an example would be very welcome.
Use the Format function from the VBA.Strings built-in module:
Debug.Print Format(Now, "YYYY-MM-DD")
Dim sToday As String
sToday = CStr(Date)
That gives sToday value, e.g. "2020-12-31", in the format of my system's date.
In some VBA, the Format() function is not available. In this case, you can do it the old fashion:
y = cstr(year(now))
m = right("0" + cstr(month(now)),2)
d = right("0" + cstr(day(now)),2)
mydate = y + "-"+ m + "-" + d