I have this date TimeAndDateTZ = "2014-12-15T21:48:40Z"
I'm trying to get two different variables from it:
Desired Output:
Date = "2014-12-15"
Time24 = "21:48:40"
Time12 = "09:48:40"
I know I could split() it on the "T" and replace() the "Z" but I want to know to do it properly.
I have tried to use CDATE and DateValue but I get an error.
What am I doing wrong?
Edit:
Everything will be continue to be used as Strings, and yes TimeAndDateTZ is a string.
Edit #2:
(See my answer)
Consider the following:
Sub dural()
TimeAndDateTZ = "2014-12-15T21:48:40Z"
ary = Split(Replace(TimeAndDateTZ, "Z", ""), "T")
Datee = ary(0)
Time24 = ary(1)
Time12 = Split(CStr(TimeValue(Time24)), " ")(0)
MsgBox Datee & vbCrLf & Time24 & vbCrLf & Time12
End Sub
DateSerial() and TimeSerial() would be good places to start. See This Tutorial for more information. Since your TimeAndDateTZ appears to be a string, you will need to extract the various parts of the date and time and add the components to the DateSerial() and TimeSerial() methods.
Sub DateTest()
Dim strDate As String
strDate = "2014-12-15T21:48:40Z"
Set objRegExp = CreateObject("vbscript.regexp")
objRegExp.Global = True
objRegExp.IgnoreCase = True
objRegExp.Pattern = "T[0-9]{1,2}:[0-9]{1,2}:[0-9]{1,2}Z"
If objRegExp.Test(strDate) Then entDate = objRegExp.Replace(strDate, "")
objRegExp.Pattern = "[0-9]{1,4}-[0-9]{1,2}-[0-9]{1,2}"
If objRegExp.Test(strDate) Then entTime = objRegExp.Replace(strDate, "")
entTime = Replace(entTime, "T", ""): entTime = Replace(entTime, "Z", "")
End Sub
Related
I'm trying to determine if a column has a header or not via VBA. Basically the column will have data following an unknown but identical regex pattern. My plan is to test if A2 has the same type regex string as A1. It would likely even be the same ID + 1. Eg
A1 = X001
A2 = X002
Func IsHeader("A") = True
A1 = ID's
A2 = X001
Func IsHeader("A") = False
I've got an idea to utilize an existing script I made to generate a regex pattern based on an input alphanumerical string, but I'm interested to see what other idea's/ways people might have of solving the issue. I realize there isn't much code, but I know I can do this and I'm working on it now. If you're not interested in answering, thats ok!
Update: Posted Answer, but I'm looking for more than a code review as I realize there is an exchange for that. I'd like to know better ways to achieve goal with a different attack vector.
This is what I got! I'm not sure how SO feels about code reviews, but im interested in what ppl think and how else they could "skin the cat" so please feel free to post an answer.
Sub Test()
If IsHeader = True Then
MsgBox "Has Header"
Else
MsgBox "No Header"
End If
End Sub
Public Function IsHeader() As Boolean
A1Pattern = RegExPattern(Range("A1").Value)
A2Pattern = RegExPattern(Range("A2").Value)
If A1Pattern = A2Pattern Then
IsHeader = True
End If
End Function
Public Function RegExPattern(my_string) As String
RegExPattern = ""
'''Special Character Section'''
Dim special_charArr() As String
Dim special_char As String
special_char = "!,#,#,$,%,^,&,*,+,/,\,;,:"
special_charArr() = Split(special_char, ",")
'''Special Character Section'''
'''Alpha Section'''
Dim regexp As Object
Set regexp = CreateObject("vbscript.regexp")
Dim strPattern As String
strPattern = "([a-z])"
With regexp
.ignoreCase = True
.Pattern = strPattern
End With
'''Alpha Section'''
Dim buff() As String
'my_string = "test1*1#"
ReDim buff(Len(my_string) - 1)
Dim i As Variant
For i = 1 To Len(my_string)
buff(i - 1) = Mid$(my_string, i, 1)
char = buff(i - 1)
If IsNumeric(char) = True Then
'MsgBox char & " = Number"
RegExPattern = RegExPattern & "([0-9])"
End If
For Each Key In special_charArr
special = InStr(char, Key)
If special = 1 Then
If Key <> "*" Then
'MsgBox char & " = Special NOT *"
RegExPattern = RegExPattern & "^[!##$%^&()].*$"
Else
'MsgBox char & " = *"
RegExPattern = RegExPattern & "."
End If
End If
Next
If regexp.Test(char) Then
'MsgBox char & " = Alpha"
RegExPattern = RegExPattern & "([a-z])"
End If
Next
'RegExPattern = Chr(34) & RegExPattern & Chr(34)
'MsgBox RegExPattern
End Function
Everything is working except for that little comma in the 5th word. How to remove that? My code is as follows.
The text looks like this: The data as of 20.12.2019, and so on.
I only want 20.12.2019 without that comma. Any clue? Thanks.
Public Function FindWord(Source As String, Position As Integer)
Dim arr() As String
arr = VBA.Split(Source, " ")
xCount = UBound(arr)
If xCount < 1 Or (Position - 1) > xCount Or Position < 0 Then
FindWord = ""
Else
FindWord = arr(Position - 1)
End If
End Function
subroutine calls the function.
Sub InsertDate()
Sheets("Sheet1").Range("B3").Value = FindWord(Sheets("Sheet2").Range("A2"), 5)
End Sub
So just for fun, a short introduction to regular expressions (which, by no means, I am an expert in):
Sub Test()
Dim str As String: str = "The data as of 20.12.2019, and so on."
Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "\b(\d{2}.\d{2}.\d{4})"
regex.Global = True
Debug.Print regex.Execute(str)(0)
End Sub
This would be good practice if your string won't follow that same pattern all the time. However when it does, there are some other good alternatives mentioned in comments and answers.
One option is to Replace:
Sub InsertDate()
With Sheets("Sheet1").Range("B3")
.Value = FindWord(Sheets("Sheet2").Range("A2"), 5)
.Value = Replace(.Value, ",", "")
End With
End Sub
This is still text-that-looks-like-a-date, so you can call DateValue to convert it.
.Value = Replace(.Value, ",", "")
.Value = DateValue(.Value) '<~ add this line
I have a problem using the StrComp Function in VBA to compare two Strings.
Public Function upStrEQ(ByVal ps1 As String, ByVal ps2 As String) As Boolean
upStrEQ = False
If StrComp(ps1, ps2, vbTextCompare) = 0 Then
upStrEQ = True
End If
If Len(ps1) = Len(ps2) Then
Debug.Print ps1 & vbNewLine & ps2 & vbNewLine & upStrEQ
End If
End Function
Debug output:
Technischer Name
Technischer Name
Falsch
As you can see the two strings have the same length and equal text but upStrEQ is False and StrComp did not return 0.
Any help would be nice. Thanks.
Update:
Since one of the Strings being passed to the function is read from a cell before I made a sample document so you can reproduce my error: https://www.dropbox.com/s/6yh6d4h8zxz533a/strcompareTest.xlsm?dl=0
StrComp() works quite nice. The problem is with your input, probably you have a hidden space or a new line.
Test your code like this:
Public Function upStrEQ(ByVal ps1 As String, ByVal ps2 As String) As Boolean
If StrComp(ps1, ps2, vbTextCompare) = 0 Then
upStrEQ = True
End If
If Len(ps1) = Len(ps2) Then
Debug.Print ps1 & vbNewLine & ps2 & vbNewLine & upStrEQ
End If
End Function
Public Sub TestMe()
Debug.Print upStrEQ("a", "a")
End Sub
Furthermore, the default value of a boolean function is false, thus you do not need to set it at the beginning.
In order to clean a bit your input, only to letters and numbers, you can use a custom RegEx function. Thus, something like this would always return letters and numbers:
Public Function removeInvisibleThings(s As String) As String
Dim regEx As Object
Dim inputMatches As Object
Dim regExString As String
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.pattern = "[^a-zA-Z0-9]"
.IgnoreCase = True
.Global = True
Set inputMatches = .Execute(s)
If regEx.test(s) Then
removeInvisibleThings = .Replace(s, vbNullString)
Else
removeInvisibleThings = s
End If
End With
End Function
Public Sub TestMe()
Debug.Print removeInvisibleThings("aa1 Abc 67 ( *^ 45 ")
Debug.Print removeInvisibleThings("aa1 ???!")
Debug.Print removeInvisibleThings(" aa1 Abc 1267 ( *^ 45 ")
End Sub
In your code, use it when you are passing the parameters ps1 and ps2 to the upStrEQ.
I have a requirement to remove the text between two strings.
An example of the text is:
Abc%678x”cv ","#metadata":{abxkl "DataArray"}},{"columnName":"
The requirement is to start removing text from ,"#met till "}
The requirement is to use ,"#met and "} as start and end identifiers and remove text between them including the identifiers.
There could be multiple occurrence of this start and end identifiers within the file.
The output should look like this:
Abc%678x”cv "},{"columnName":"
How to write an Excel formula or simple VBA script to remove text between two strings, including identifiers?
Formula:
=LEFT(A1,FIND(",""#met",A1)-1)&RIGHT(A1,LEN(A1)-FIND("}",A1,FIND("""#met",A1)))
VBA function:
Function RemoveBetweenSeparators( _
ByVal MyString As String, _
ByVal SepL As String, _
ByVal SepR As String) _
As String
Dim sL As String
Dim sR As String
sL = Split(MyString, SepL)(0)
sR = Replace(MyString, sL, "")
sR = Replace(sR, Split(sR, SepR)(0) & SepR, "")
RemoveBetweenSeparators = sL & sR
End Function
Which can be used like this:
=RemoveBetweenSeparators(A1,"""#meta","}")
EDIT: I also missed the 'multiple occurences' requirement, first time round! That makes it a little trickier, but try this:
Function RemoveBetweenSeparatorsMultiple( _
ByVal MyString As String, _
ByVal SepL As String, _
ByVal SepR As String) _
As String
Dim sOut As String
Dim sL As String
Do Until InStr(MyString, SepL) = 0
sL = Split(MyString, SepL)(0)
sOut = sOut & sL
MyString = Replace(MyString, sL & SepL, "", 1, 1)
sL = Split(MyString, SepR)(0)
MyString = Replace(MyString, sL & SepR, "", 1, 1)
Loop
RemoveBetweenSeparatorsMultiple = sOut & MyString
End Function
My apology, didn't notice that there could be multiple occurrence. I'll edit my answer later.
Assuming the original text is stored in A1.
A2=LEFT(A1,FIND(",""#met",A1)-1)&RIGHT(A1,LEN(A1)-FIND("""}",A1)-1)
Note: If you need to force excel treat a double quote mark as a normal text, you have to type two " for representing a ".
If there may be multiple occurrence, try this
Private Function RemoveText(ByVal tgtString As String, ByVal StartText As String, ByVal EndText As String) As String
Do While InStr(1, tgtString, StartText) > 0
tgtString = Left(tgtString, InStr(1, tgtString, StartText) - 1) & Right(tgtString, Len(tgtString) - InStr(1, tgtString, EndText) - 1)
Loop
RemoveText = tgtString
End Function
Private Sub test()
'remove certain string in A1 and store the result in A2
Range("A2").Value = RemoveText(Range("A1").Value, ",""#met", """}")
End Sub
maybe somthing like this (not tested though!) :
Function cleanedStr (inpStr as String; beginDel as string; endDel as Str) as String
Dim idx as long
Dim take as boolean
Dim outStr as String
Dim myCh as String
take = true
outStr = ""
for idx = 1 to len(inpStr)
myCh = mid(inpStr, idx, 1)
if myCh = beginDel then take = false
if take then
outStr = outStr & myCh
else
if myCh = endDel then take = true
end if
next idx
cleanedStr = outStr
end Function
Mind, the begin-identifier is 1 character only.
beginDel would be # and endDel would be }
This can be done easily using VBA and regular expressions:
Option Explicit
Function RemoveBetweenDelimiters(S As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = True
.ignorecase = True
.Pattern = ",""#met[^}]+}"
RemoveBetweenDelimiters = .Replace(S, "")
End With
End Function
The regex interpretation:
,"#met[^}]+}
,"#met[^}]+}
Options: Case insensitive; ^$ match at line breaks
Match the character string “,"#met” literally ,"#met
Match any character that is NOT a “}” [^}]+
Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
Match the character “}” literally }
Created with RegexBuddy
I want to parse out the year info from a string like this one
$8995 Apr 18 2008 Honda Civic Hybrid $8995 (Orem) pic map cars & trucks - by owner
Since I retrieve this string online, sometimes the year element is not at the same place. The way I do it is to split the string by space using split function, then check if each node of the array contains only numeric digits.
However when i use the function IsNumeric, it also returns "$8995" node as true as well.
What is a good way to check if a string contains only numbers, no "$", no ".", not anything else?
Or in my situation, is there a better way to retrieve the year information?
Thanks.
This can be accomplished as a single line of code, using the Like operator
Function StringIsDigits(ByVal s As String) As Boolean
StringIsDigits = Len(s) And (s Like String(Len(s), "#"))
End Function
Will it be the case that all the strings with "years" will have substrings that look like dates? If that is the case, you could just cycle through the string looking for the first group of three that looks like a date, extracting the year from that:
Option Explicit
Function FindYear(S As String) As Long
Dim SS As Variant
Dim sDate As String
Dim I As Long, J As Long
SS = Split(S, " ")
For I = 0 To UBound(SS) - 2
sDate = ""
For J = 0 To 2
sDate = " " & sDate & " " & SS(I + J)
Next J
sDate = Trim(sDate)
If IsDate(sDate) Then
FindYear = Year(sDate)
Exit Function
End If
Next I
End Function
WIthout using Regular Expressions or some very complicated logic, it's going to be difficult to be perfect.
This code will return the pure numeric substrings, but in the case of your example it will return "18" and "2008". You could obviously try to add some more logic to disallow "18" (but allow "13" or "09", etc., but like I said that starts getting complicated. I am happy to help with that, but not knowing exactly what you want, I think it's best to leave that up to you for now.
Const str$ = "$8995 Apr 18 2008 Honda Civic Hybrid $8995 (Orem) pic map cars & trucks - by owner"
Option Explicit
Sub FindNumericValues()
Dim var() As String
Dim numbers As Variant
var = Split(str, " ")
numbers = GetNumerics(var)
MsgBox Join(numbers, ",")
End Sub
Function GetNumerics(words() As String) As Variant
Dim tmp() As Variant
Dim i As Integer
Dim n As Integer
Dim word As Variant
Dim bNumeric As Boolean
For Each word In words
n = 0
bNumeric = True
Do While n < Len(word)
n = n + 1
If Not IsNumeric(Mid(word, n, 1)) Then
bNumeric = False
Exit Do
End If
Loop
If bNumeric Then
ReDim Preserve tmp(i)
tmp(i) = word
i = i + 1
End If
Next
GetNumerics = tmp
End Function
You could parse the year out using RegEx:
Public Function GetYear(someText As String) As Integer
With CreateObject("VBScript.RegExp")
.Global = False
.MultiLine = False
.IgnoreCase = True
.Pattern = " [\d]{4} "
If .Test(testString) Then
GetYear = CInt(.Execute(testString)(0))
Else
GetYear = 9999
End If
End With
End Function
Example code:
Public Const testString As String = "$8995 Apr 18 2008 Honda Civic Hybrid $8995 (Orem) pic map cars & trucks - by owner "
Public Function GetYear(someText As String) As Integer
With CreateObject("VBScript.RegExp")
.Global = False
.MultiLine = False
.IgnoreCase = True
.Pattern = " [\d]{4} "
If .Test(testString) Then
GetYear = CInt(.Execute(testString)(0))
Else
GetYear = 9999
End If
End With
End Function
Sub Foo()
Debug.Print GetYear(testString) '// "2008"
End Sub