How to specify a format when converting String to Date - vba

I know I can use Format() when converting a date into a string. And Cells.NumberFormat to change the display text of a date.
I'm trying to go the opposite direction. I have a string like "231211" or "08AUG11" and a corresponding date format like "YYMMDD" or "DDMMMYY" and I just need to convert the string based on the format. I already have a way to find the correct format of each string, I just need to do the conversion.
I can't seem to find the right function/method to do what I'm asking. DateTime.ParseExact doesn't seem to exist in Excel 2007, even after I added mscorlib.dll as a reference.
Is there an alternative I can use? Or how do I get DateTime.ParseExact to work properly in Excel 2007?
Since the string is not always the same length and there are about 30 different formats, it's quite annoying to conditionally split the string and interpret the substrings individually. I would love to be able to just parse the date based on the format.

here is a start to create your own function:
Function dateParser(str As String, fmt As String) As Date
If Len(str) <> Len(fmt) Then Exit Function
Dim dy As Long
Dim mnth As String
Dim yr As Long
Dim mnthnm As Long
Dim i As Long
For i = 1 To Len(str)
If UCase(Mid(fmt, i, 1)) = "D" Then
dy = dy * 10 + CLng(Mid(str, i, 1))
ElseIf UCase(Mid(fmt, i, 1)) = "Y" Then
yr = yr * 10 + CLng(Mid(str, i, 1))
ElseIf UCase(Mid(fmt, i, 1)) = "M" Then
mnth = mnth & Mid(str, i, 1)
End If
Next i
If IsNumeric(mnth) Then
mnthnm = CLng(mnth)
Else
mnthnm = Month(CDate("01 " & mnth & " 2020"))
End If
dateParser = DateSerial(yr, mnthnm, dy)
End Function
Used like:
Sub test()
Dim str As String
str = "08AUG11"
Dim fmt As String
fmt = "DDMMMYY"
Dim x As Date
x = dateParser(str, fmt)
debug.print x
End Sub

Related

VBA convert unusual string to Date

I wanted to scrape data from yahoo as an excercise and then make a graph from it. I encountered a problem where when I scrape the dates, they are in a rather weird format:
?10? ?Aug?, ?2020
The question marks in the string are not realy question marks, they are some characters unknown to me, so I cannot remove them with Replace().
Then, when I try to use CDate() to convert this to Date format, the code crashed on "Type mismatch" error.
What I would need is to either find a way to find out what those characters are in order to remove them with Replace(), or to somehow convert even this weird format to a Date.
Alternatively, somehow improving the scraping procedure - so far I've been using for example
ie.document.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(3).innerText
to get the data - would also solve this problem.
If anyone wanted to try to scrape it, too an example url:
https://finance.yahoo.com/quote/LAC/history?period1=1469404800&period2=1627171200&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true
An example of my code follows:
DateString = doc.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(j).innerText
LeftDateString = Clean_NonPrintableCharacters(DateString)
Worksheets("Stock_data").Range("A2").Value = CDate(LeftDateString)
With regexp:
Function GetDate(txt)
' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
Dim re As New RegExp, retval(0 To 2), patterns, i, result
patterns = Array("\b\d\d\b", "\b[a-zA-Z]+\b", "\b\d{4}\b")
For i = 0 To 2
re.Pattern = patterns(i)
Set result = re.Execute(txt)
If result Is Nothing Then Exit Function 'If no day, month or year is found, GetDate() returns ""
retval(i) = result(0)
Next
GetDate = Join(retval)
End Function
Sub Usage()
For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?")
Debug.Print GetDate(txt)
Next
End Sub
Prints:
10 Aug 2020
13 Jul 2020
18 March 2021
Edit 2
Function GetDate2(txt)
' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
Static re As RegExp, months As Collection
Dim result
If re Is Nothing Then 'do it once
Set re = New RegExp
re.Pattern = "[^a-zA-Z0-9]"
re.Global = True
Set months = New Collection
cnt = 1
For Each m In Split("jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec", ",")
months.Add cnt, m
cnt = cnt + 1
Next
End If
result = Split(WorksheetFunction.Trim(re.Replace(txt, " ")))
For i = 0 To UBound(result)
If Not IsNumeric(result(i)) Then
result(i) = Left(LCase(result(i)), 3)
On Error Resume Next
result(i) = months(result(i))
On Error GoTo 0
End If
Next
result = Join(result)
If IsDate(result) Then GetDate2 = CDate(result)
End Function
Sub Usage2()
For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?", _
"01/12/2021", "04.18.2020", "15 10 20")
Debug.Print GetDate2(txt)
Next
End Sub
Prints:
10.08.2020
13.07.2020
18.03.2021
01.12.2021
18.04.2020
15.10.2020
Note. The order of the dd and mm may be vary
I would use something like so. I've used your ? as question marks for this example, i assumed they were all the same wierd character. This outputs
10 Aug 2020
Sub d()
Dim d As String
d = "?10? ?Aug?, ?2020"
d = Replace(Replace(d, Chr(Asc(Left(d, 1))), vbNullString), ",", vbNullString)
Debug.Print d
End Sub
you could loop though each char in the string and check its ascii values and create your date string from that. Example
Sub GetTheDate(sDate As String)
'97 - 122: lower case Ascii values
Dim i As Integer
Dim strDate As String
'loop through each char
For i = 1 To Len(sDate)
'check to see if it is numeric
If IsNumeric(Mid(sDate, i, 1)) Then
'numeric so add it to the string
strDate = strDate & Mid(sDate, i, 1)
Else
'check to see if it is a char a-z
If Asc(LCase(Mid(sDate, i, 1))) >= 97 And Asc(LCase(Mid(sDate, i, 1))) <= 122 Then
'it is an a char from a-z so add it to string
strDate = strDate & Mid(sDate, i, 1)
Else
'chekc for a space and add a comma - this sets up being able to use cdate()
If Mid(sDate, i, 1) = " " Then
strDate = strDate & ","
End If
End If
End If
Next i
'convert it and print it
Debug.Print CDate(strDate)
End Sub

How do I split up a year range into individual years in a given field?

I was working in Access to make a query of a few tables, and realized that a column of a table does not meet a specific requirement.
I have a field that consists of thousands of records, and it contains "years" in the following format (an example) : 1915-1918.
What I want to accomplish is to make that value individual in the records. So
the end result would be : 1915,1916,1917,1918.
Basically, I want to convert 1915-1918 to 1915,1916,1917,1918.
I thought a simple concatenation would suffice, but could not wrap my head around how to make it so that it can do it for all thousands of records. I did some research and reached the conclusion that a user defined function might be the way to go. How would I go about this?
When your field value consists of 4 digits followed by a dash followed by 4 more digits, this function returns a comma-separated list of years.
In any other cases (Null, a single year such as "1915" instead of a year range, or anything else), the function returns the starting value.
Public Function YearList(ByVal pInput As Variant) As Variant
Dim astrPieces() As String
Dim i As Long
Dim lngFirst As Long
Dim lngLast As Long
Dim varReturn As Variant
If pInput Like "####-####" Then
astrPieces = Split(pInput, "-")
lngFirst = CLng(astrPieces(0))
lngLast = CLng(astrPieces(1))
For i = lngFirst To lngLast
varReturn = varReturn & "," & CStr(i)
Next
If Len(varReturn) > 0 Then
varReturn = Mid(varReturn, 2)
End If
Else
varReturn = pInput
End If
YearList = varReturn
End Function
However, this approach assumes the start year in each range will be less than the end year. In other words, you would need to invest more effort to make YearList("1915-1912") return a list of years instead of an empty string.
If that function returns what you want, you could use it in a SELECT query.
SELECT years_field, YearList(years_field)
FROM YourTable;
Or if you want to replace the stored values in your years field, you can use the function in an UPDATE query.
UPDATE YourTable
SET years_field = YearList(years_field);
You can use the Split function to return an array from the "years" field that contains the upper and lower year. Then loop from the lower year to the upper year and build the concatenated string. For example:
Public Function SplitYears(Years As String) As String
Dim v As Variant
Dim i As Long
Dim s As String
v = Split(Years, "-", 2)
If UBound(v) = 1 Then
For i = v(0) To v(1)
s = s & "," & CStr(i)
Next i
s = Right(s, Len(s) - 1)
Else
s = v(0)
End If
SplitYears = s
End Function
In Excel, make a sequential reference table of Years, for the range of years that you expect to encounter.
Next, use left and right functions to get the start and end of the range.
Create an update query and update the target field with a concatenation of target field to itself and then also the reference year values between that also fit between the start and end of the range.
Or I guess you could make a user function.
Add the code below to a module in Visual Basic
Public Function CommaDates(Start_End) As String
Dim strt As String
Dim endd As String
Dim x As Long
strt = Left(Start_End, 4)
endd = Right(Start_End, 4)
CommaDates = strt
For x = strt + 1 To endd
CommaDates = CommaDates & "," & x
Next x
End Function
Call this in a query like NEW_DATE: CommaDates([OLD_DATE_FIELD_NAME])

How to convert bit number to digit

I'm working to create an Excel macro using VBA to convert bit strings to numbers. They are not binary numbers, each '1' stands for it's own number.
e.g: 1100000000000000000010001
from the left, the first bit represents "1", the second bit represents "2", third bit represents "0", and so on. The total quantity of bits in each string is 25.
I want VBA to convert it and show results like so: 1, 2, 21, 25.
I tried using Text to Columns but was not successful.
Try something like this:
Sub Execute()
Dim buff() As String
Dim i As Integer, total As Double
buff = Split(StrConv(<theString>, vbUnicode), Chr$(0))
total = 0
For i = 0 To UBound(buff)
Debug.Print (buff(i))
'total = total + buff(i) * ??
Next i
End Sub
Consider:
Public Function BitPicker(sIn As String) As String
For i = 1 To Len(sIn)
If Mid(sIn, i, 1) = 1 Then
BitPicker = BitPicker & i & ","
End If
Next
BitPicker = Mid(BitPicker, 1, Len(BitPicker) - 1)
End Function
Another non-VBA solution, based on the OP' initial approach and with a layout designed to facilitate multiple 'conversions' (ie copy formulae down to suit):
Does this have to be VBA? Give a data setup like this:
The formula in cell B4 and copied down to B33 is:
=IF(ROWS(B$3:B3)>LEN($B$1)-LEN(SUBSTITUTE($B$1,"1","")),"",FIND("#",SUBSTITUTE($B$1,"1","#",ROWS(B$3:B3))))
The formula cells are formatted as General and the the Bit String cell (B1) is formatted as Text.
Try this:
Function ConvertMyRange(Rng As Range) As String
Dim MyString As String
MyString = Rng.Text
Dim OutPutString As String
For i = 1 To Len(MyString)
If Mid(MyString, i, 1) = "1" Then OutPutString = OutPutString & ", " & i
Next i
' Get rid of first ", " that was added in the loop
If Len(OutPutString) > 0 Then
OutPutString = Mid(OutPutString, 2)
End If
ConvertMyRange = OutPutString
End Function
For your input, the output is 1, 2, 21, 25

Checking Row by Row in a report

With reference to this question,
Changing Row Colour according to condition
I got familiar with Conditional formatting. However I still face this problem.
I am using this code to convert time into Time in Minutes.
Dim TestString As String
TestString = Me.Duration
Dim TestArray() As String
TestArray = Split(TestString, ":")
Dim Hours As String
Dim Minutes As String
Dim Seconds As String
Dim HoursMinutes As Integer
Dim MinutesMinutes As Integer
Dim SecondsMinutes As Integer
Hours = TestArray(0)
Minutes = TestArray(1)
Seconds = TestArray(2)
HoursMinutes = CInt(TestArray(0)) * 60
MinutesMinutes = CInt(TestArray(1))
SecondsMinutes = CInt(TestArray(2)) / 60
Dim TimeInMinutes As Integer
TimeInMinutes = HoursMinutes + MinutesMinutes + SecondsMinutes
Me.Duration = TimeInMinutes
However, for some reason this is not working.
Have you any ideas how can I do this for seperate rows?
Thanks in advance
ADD:
I tried creating a field for Minutes, the problem is that they will get all the same number.
the below code has a String variable called dateTime which stores the current date and time in this format: 27/08/2013 10:55:52
The dateTime String is getting split into a Variant arr array
Split(dateTime, Chr(32))(1) returns the time 10:55:52 part of the dateTime variable
then Split(Split(dateTime, Chr(32))(1), ":") splits the time into 3 numbers using : (colon) as delimiter
So you end up with with arr holding # of hrs, # of minutes, # of seconds.
The CLng((arr(0) * 60) + arr(1) + (arr(2) / 60)) returns an Integer/Long representation of the calculated time value
Stick the below sub in a fresh module and run it
Sub Convert()
Dim dateTime As String
dateTime = now
Dim arr
arr = Split(Split(dateTime, Chr(32))(1), ":")
MsgBox "The time " & Split(dateTime, Chr(32))(1) & vbCrLf & _
" as Integer is equal to " & CLng((arr(0) * 60) + arr(1) + (arr(2) / 60))
End Sub

Inserting into an Excel VBA string

In JAVA or C++, we can do something along the line of myString.insert(position, word). Is there a way we can do the same in Excel VBA's string? In my worksheet, I have a string looks like this: 01 / 01 / 995, I wants to insert a 1 into the year, so make it 01 / 01 / 1995.
Dim test_date As String
test_date = "01 / 25 / 995"
test_date = Mid(test_date, 1, 10) & "1" & Mid(test_date, 11, 4)
Is there another easier / more elegant way to do it?
I dont think there is a cleaner way of doing it so you could just wrap it up in a function. Another way of doing it would be with replace, but it's not any cleaner.
Function Insert(source As String, str As String, i As Integer) As String
Insert = Replace(source, tmp, str & Right(source, Len(source)-i))
End Function
or just modify what you have
Function Insert(source As String, str As String, i As Integer) As String
Insert = Mid(source, 1, i) & str & Mid(source, i+1, Len(source)-i)
End Function
This a version of the accepted answer, with added tests and working the way I would expect it to work:
Function Insert(original As String, added As String, pos As Long) As String
If pos < 1 Then pos = 1
If Len(original) < pos Then pos = Len(original) + 1
Insert = Mid(original, 1, pos - 1) _
& added _
& Mid(original, pos, Len(original) - pos + 1)
End Function
The tests pass:
Public Sub TestMe()
Debug.Print Insert("abcd", "ff", 0) = "ffabcd"
Debug.Print Insert("abcd", "ff", 1) = "ffabcd"
Debug.Print Insert("abcd", "ff", 2) = "affbcd"
Debug.Print Insert("abcd", "ff", 3) = "abffcd"
Debug.Print Insert("abcd", "ff", 4) = "abcffd"
Debug.Print Insert("abcd", "ff", 100) = "abcdff"
End Sub
Here is my fifty cents for this question.
First of all, I need to give credit to WONG, Ming Fung from wmfexel where I found this trick.
Unlike the VBA Replace function who asks for the String to replace, the Replace Worksheet function only asks for the position in the Origin String and the number of characters to overwrite.
By "abusing" this overwrite parameter, setting it to 0 allows us to add a given string at a specific position in an Orignin string by replacing 0 characters of it.
Here it how it works :
Dim test_date As String
test_date = "01 / 25 / 995"
test_date = Worksheetfunction.Replace(test_date, 11, 0, "1")
'Now test_date = "01 / 25 / 1995" as we added "1" at the 11th position in it
As you can see, it's really convenient and readable.
For those who are picky and thinks the name Replace is just confusing, Wrap it in an Insert function and you'll be all done ;).