I have a problem with the split function I have currently. I am able to either split with 1 delimited only (split()) or split with many single characters (custom()). Is there a way to split this? Keep in mind that these delimiters are not in order.
"MY!!DATA##IS!!LOCATED##HERE!!IN!!BETWEEN##THE##ATS!!AND!!MARKS"
I need your help to get the following result
"MY" , "DATA" , "IS" , "LOCATED" , "HERE" , "IN" , "BETWEEN","THE", "ATS" , "AND", "MARKS"
thanks
Create a new VB6 EXE project and add a button to the form you will be given, and use the following code for the Button1_Click event:
Private Sub Command1_Click()
Dim myText As String
Dim myArray() As String
Dim InBetweenAWord As Boolean
Dim tmpString As String
Dim CurrentCount As Integer
CurrentCount = 0
myText = "MY!!DATA##IS!!LOCATED##HERE!!IN!!BETWEEN##THE##ATS!!AND!!MARKS"
For i = 1 To Len(myText)
If (Mid(myText, i, 1) = "#" Or Mid(myText, i, 1) = "!") And InBetweenAWord = True Then
CurrentCount = CurrentCount + 1
ReDim Preserve myArray(CurrentCount)
myArray(CurrentCount) = tmpString
tmpString = ""
InBetweenAWord = False
Else
If (Mid(myText, i, 1) <> "#" And Mid(myText, i, 1) <> "!") Then
tmpString = tmpString & Mid(myText, i, 1)
InBetweenAWord = True
End If
End If
Next
For i = 1 To CurrentCount
MsgBox myArray(i) 'This will iterate through all of your words
Next
End Sub
Notice that once the first For-Next loop is finished, the [myArray] will contain all of your words without the un-desired characters, so you can use them anywhere you like. I just displayed them as MsgBox to the user to make sure my code worked.
Character handling is really awkward in VB6. I would prefer using built-in functions like this
Private Function MultiSplit(ByVal sText As String, vDelims As Variant) As Variant
Const LNG_PRIVATE As Long = &HE1B6 '-- U+E000 to U+F8FF - Private Use Area (PUA)
Dim vElem As Variant
For Each vElem In vDelims
sText = Replace(sText, vElem, ChrW$(LNG_PRIVATE))
Next
MultiSplit = Split(sText, ChrW$(LNG_PRIVATE))
End Function
Use MultiSplit like this
Private Sub Command1_Click()
Dim vElem As Variant
For Each vElem In MultiSplit("MY!!DATA##IS!!LOCATED##HERE!!IN!!BETWEEN##THE##ATS!!AND!!MARKS", Array("!!", "##"))
Debug.Print vElem
Next
End Sub
Related
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 need to find numbers from a string. How does one find numbers from a string in VBA Excel?
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Calling this with:
Dim myStr as String
myStr = onlyDigits ("3d1fgd4g1dg5d9gdg")
MsgBox (myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Regular expressions are built to parse. While the syntax can take a while to pick up on this approach is very efficient, and is very flexible for handling more complex string extractions/replacements
Sub Tester()
MsgBox CleanString("3d1fgd4g1dg5d9gdg")
End Sub
Function CleanString(strIn As String) As String
Dim objRegex
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[^\d]+"
CleanString = .Replace(strIn, vbNullString)
End With
End Function
Expanding on brettdj's answer, in order to parse disjoint embedded digits into separate numbers:
Sub TestNumList()
Dim NumList As Variant 'Array
NumList = GetNums("34d1fgd43g1 dg5d999gdg2076")
Dim i As Integer
For i = LBound(NumList) To UBound(NumList)
MsgBox i + 1 & ": " & NumList(i)
Next i
End Sub
Function GetNums(ByVal strIn As String) As Variant 'Array of numeric strings
Dim RegExpObj As Object
Dim NumStr As String
Set RegExpObj = CreateObject("vbscript.regexp")
With RegExpObj
.Global = True
.Pattern = "[^\d]+"
NumStr = .Replace(strIn, " ")
End With
GetNums = Split(Trim(NumStr), " ")
End Function
Use the built-in VBA function Val, if the numbers are at the front end of the string:
Dim str as String
Dim lng as Long
str = "1 149 xyz"
lng = Val(str)
lng = 1149
Val Function, on MSDN
I was looking for the answer of the same question but for a while I found my own solution and I wanted to share it for other people who will need those codes in the future. Here is another solution without function.
Dim control As Boolean
Dim controlval As String
Dim resultval As String
Dim i as Integer
controlval = "A1B2C3D4"
For i = 1 To Len(controlval)
control = IsNumeric(Mid(controlval, i, 1))
If control = True Then resultval = resultval & Mid(controlval, i, 1)
Next i
resultval = 1234
This a variant of brettdj's & pstraton post.
This will return a true Value and not give you the #NUM! error. And \D is shorthand for anything but digits. The rest is much like the others only with this minor fix.
Function StripChar(Txt As String) As Variant
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\D"
StripChar = Val(.Replace(Txt, " "))
End With
End Function
This is based on another answer, but is just reformated:
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
'
' Skips all characters in the input string except digits
'
Function GetDigits(ByVal s As String) As String
Dim char As String
Dim i As Integer
GetDigits = ""
For i = 1 To Len(s)
char = Mid(s, i, 1)
If char >= "0" And char <= "9" Then
GetDigits = GetDigits + char
End If
Next i
End Function
Calling this with:
Dim myStr as String
myStr = GetDigits("3d1fgd4g1dg5d9gdg")
Call MsgBox(myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Alternative via Byte Array
If you assign a string to a Byte array you typically get the number equivalents of each character in pairs of the array elements. Use a loop for numeric check via the Like operator and return the joined array as string:
Function Nums(s$)
Dim by() As Byte, i&, ii&
by = s: ReDim tmp(UBound(by)) ' assign string to byte array; prepare temp array
For i = 0 To UBound(by) - 1 Step 2 ' check num value in byte array (0, 2, 4 ... n-1)
If Chr(by(i)) Like "#" Then tmp(ii) = Chr(by(i)): ii = ii + 1
Next i
Nums = Trim(Join(tmp, vbNullString)) ' return string with numbers only
End Function
Example call
Sub testByteApproach()
Dim s$: s = "a12bx99y /\:3,14159" ' [1] define original string
Debug.Print s & " => " & Nums(s) ' [2] display original string and result
End Sub
would display the original string and the result string in the immediate window:
a12bx99y /\:3,14159 => 1299314159
Based on #brettdj's answer using a VBScript regex ojbect with two modifications:
The function handles variants and returns a variant. That is, to take care of a null case; and
Uses explicit object creation, with a reference to the "Microsoft VBScript Regular Expressions 5.5" library
Function GetDigitsInVariant(inputVariant As Variant) As Variant
' Returns:
' Only the digits found in a varaint.
' Examples:
' GetDigitsInVariant(Null) => Null
' GetDigitsInVariant("") => ""
' GetDigitsInVariant(2021-/05-May/-18, Tue) => 20210518
' GetDigitsInVariant(2021-05-18) => 20210518
' Notes:
' If the inputVariant is null, null will be returned.
' If the inputVariant is "", "" will be returned.
' Usage:
' VBA IDE Menu > Tools > References ...
' > "Microsoft VBScript Regular Expressions 5.5" > [OK]
' With an explicit object reference to RegExp we can get intellisense
' and review the object heirarchy with the object browser
' (VBA IDE Menu > View > Object Browser).
Dim regex As VBScript_RegExp_55.RegExp
Set regex = New VBScript_RegExp_55.RegExp
Dim result As Variant
result = Null
If IsNull(inputVariant) Then
result = Null
Else
With regex
.Global = True
.Pattern = "[^\d]+"
result = .Replace(inputVariant, vbNullString)
End With
End If
GetDigitsInVariant = result
End Function
Testing:
Private Sub TestGetDigitsInVariant()
Dim dateVariants As Variant
dateVariants = Array(Null, "", "2021-/05-May/-18, Tue", _
"2021-05-18", "18/05/2021", "3434 ..,sdf,sfd 444")
Dim dateVariant As Variant
For Each dateVariant In dateVariants
Debug.Print dateVariant & ": ", , GetDigitsInVariant(dateVariant)
Next dateVariant
Debug.Print
End Sub
Public Function ExtractChars(strRef$) As String
'Extract characters from a string according to a range of charactors e.g'+.-1234567890'
Dim strA$, e%, strExt$, strCnd$: strExt = "": strCnd = "+.-1234567890"
For e = 1 To Len(strRef): strA = Mid(strRef, e, 1)
If InStr(1, strCnd, strA) > 0 Then strExt = strExt & strA
Next e: ExtractChars = strExt
End Function
In the immediate debug dialog:
? ExtractChars("a-5d31.78K")
-531.78
I am in the following situation: I have a function, that takes a ParamArray of type variant and generates a string from the keywords given in its ParamArray in a special manner by execution mergeToString.
Function function1(ParamArray var() As Variant) As String
For i = LBound(var) To UBound(var)
function1 = mergeToString(function1, CStr(var(i))
Next i
End Function
In another subroutine, I have an array of strings obtained from the Split Function in VBA and want to use it as an input for function1
Sub displayFCTN1()
Dim arr() As String
arr() = Split("foo|bar", "|")
'and here I ran out of ideas...
Debug.Print function1(**???**)
End Sub
The two lines
function1(**???**)
function1("foo","bar")
should be equivalent the first somehow using arr().
In Matlab this is relatively easy - I know, VBA is not Matlab, still this might help as an extended description of my problem:
you could most likely do it by using the colon operator in Matlab
function1(arr(:))
since then the fields of the array arr() count as "free" parameters.
Is there something comparable to this in VBA? I tried ReDim already, that somehow didn't do the job (as far as I tried).
Thank you for your help!
You need to test, whether the first item of array is array:
Sub FFF()
MsgBox Func1("foo", "bar")
MsgBox Func1(Split("foo|bar", "|"))
End Sub
Function Func1$(ParamArray var() As Variant)
Dim s$, x%, args
args = IIf(IsArray(var(0)), var(0), var)
'//Do something
For x = 0 To UBound(args)
s = s & args(x) & "|"
Next
Func1 = Left$(s, Len(s) - 1)
End Function
A workaround as mentioned in the comments above
Sub displayFCTN1()
Dim arr() As String
arr() = Split("foo|bar", "|")
Myhelper arr
End Sub
Sub Myhelper(arr)
Select Case UBound(arr)
Case 0: Debug.Print function1(arr(0))
Case 1: Debug.Print function1(arr(0), arr(1))
Case 2: Debug.Print function1(arr(0), arr(1), arr(2))
Case 3: Debug.Print function1(arr(0), arr(1), arr(2), arr(3))
Case 4: Debug.Print function1(arr(0), arr(1), arr(2), arr(3), arr(4))
'etc up to 29.
Case Else
End Select
End Sub
This does require a change to function1 code, but should still work with orginal.
Sub Test()
Debug.Print function1("foo", "bar")
Dim arr() As String
arr = Split("foo|bar", "|")
Debug.Print function1(arr)
End Sub
Function function1(ParamArray var() As Variant) As String
Dim i As Long
If UBound(var) = 0 Then
For i = LBound(var(0)) To UBound(var(0))
'function1 = Join(var(0), "|")
function1 = mergeToString(function1, CStr(var(0)(i)))
Next i
Else
'Original code.
For i = LBound(var) To UBound(var)
'function1 = Join(var, "|")
function1 = mergeToString(function1, CStr(var(i)))
Next i
End If
End Function
Following is the statement
Performance;#Recruiting;#Culture and values;#Community Involvement &
Volunteerism;/Talent Development;#Workplace
I want each value present after the ;# sign to be paste in a new cell? How do i do it?
I've not used VBA for some time, but this should get you started at least:
Private Sub ProcessStr()
Dim strTest As String
Dim strArray() As String
Dim i As Integer
strTest = "YOUR STRING"
strArray = Split(strTest, ";")
For i = LBound(strArray) To UBound(strArray)
// REMOVE # SIGN HERE ?
// DO SOMETHING WITH THE VALUES
// strArray(i) - CONTAINS EACH VALUE
// PLACE IN INDIVIDUAL CELLS
Next
End Sub
Hope this helps!
dim arrString() as string
dim strInput as string
dim i as integer
strInput = "Performance;#Recruiting;#Culture and values;#Community Involvement &
Volunteerism;/Talent Development;#Workplace"
arrStrings = strings.split(strInput, ";#")
for i = 1 to ubound(arrstrings)
cells(i, 1) = arrstrings(i)
next i
I need to find numbers from a string. How does one find numbers from a string in VBA Excel?
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Calling this with:
Dim myStr as String
myStr = onlyDigits ("3d1fgd4g1dg5d9gdg")
MsgBox (myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Regular expressions are built to parse. While the syntax can take a while to pick up on this approach is very efficient, and is very flexible for handling more complex string extractions/replacements
Sub Tester()
MsgBox CleanString("3d1fgd4g1dg5d9gdg")
End Sub
Function CleanString(strIn As String) As String
Dim objRegex
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[^\d]+"
CleanString = .Replace(strIn, vbNullString)
End With
End Function
Expanding on brettdj's answer, in order to parse disjoint embedded digits into separate numbers:
Sub TestNumList()
Dim NumList As Variant 'Array
NumList = GetNums("34d1fgd43g1 dg5d999gdg2076")
Dim i As Integer
For i = LBound(NumList) To UBound(NumList)
MsgBox i + 1 & ": " & NumList(i)
Next i
End Sub
Function GetNums(ByVal strIn As String) As Variant 'Array of numeric strings
Dim RegExpObj As Object
Dim NumStr As String
Set RegExpObj = CreateObject("vbscript.regexp")
With RegExpObj
.Global = True
.Pattern = "[^\d]+"
NumStr = .Replace(strIn, " ")
End With
GetNums = Split(Trim(NumStr), " ")
End Function
Use the built-in VBA function Val, if the numbers are at the front end of the string:
Dim str as String
Dim lng as Long
str = "1 149 xyz"
lng = Val(str)
lng = 1149
Val Function, on MSDN
I was looking for the answer of the same question but for a while I found my own solution and I wanted to share it for other people who will need those codes in the future. Here is another solution without function.
Dim control As Boolean
Dim controlval As String
Dim resultval As String
Dim i as Integer
controlval = "A1B2C3D4"
For i = 1 To Len(controlval)
control = IsNumeric(Mid(controlval, i, 1))
If control = True Then resultval = resultval & Mid(controlval, i, 1)
Next i
resultval = 1234
This a variant of brettdj's & pstraton post.
This will return a true Value and not give you the #NUM! error. And \D is shorthand for anything but digits. The rest is much like the others only with this minor fix.
Function StripChar(Txt As String) As Variant
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\D"
StripChar = Val(.Replace(Txt, " "))
End With
End Function
This is based on another answer, but is just reformated:
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
'
' Skips all characters in the input string except digits
'
Function GetDigits(ByVal s As String) As String
Dim char As String
Dim i As Integer
GetDigits = ""
For i = 1 To Len(s)
char = Mid(s, i, 1)
If char >= "0" And char <= "9" Then
GetDigits = GetDigits + char
End If
Next i
End Function
Calling this with:
Dim myStr as String
myStr = GetDigits("3d1fgd4g1dg5d9gdg")
Call MsgBox(myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Alternative via Byte Array
If you assign a string to a Byte array you typically get the number equivalents of each character in pairs of the array elements. Use a loop for numeric check via the Like operator and return the joined array as string:
Function Nums(s$)
Dim by() As Byte, i&, ii&
by = s: ReDim tmp(UBound(by)) ' assign string to byte array; prepare temp array
For i = 0 To UBound(by) - 1 Step 2 ' check num value in byte array (0, 2, 4 ... n-1)
If Chr(by(i)) Like "#" Then tmp(ii) = Chr(by(i)): ii = ii + 1
Next i
Nums = Trim(Join(tmp, vbNullString)) ' return string with numbers only
End Function
Example call
Sub testByteApproach()
Dim s$: s = "a12bx99y /\:3,14159" ' [1] define original string
Debug.Print s & " => " & Nums(s) ' [2] display original string and result
End Sub
would display the original string and the result string in the immediate window:
a12bx99y /\:3,14159 => 1299314159
Based on #brettdj's answer using a VBScript regex ojbect with two modifications:
The function handles variants and returns a variant. That is, to take care of a null case; and
Uses explicit object creation, with a reference to the "Microsoft VBScript Regular Expressions 5.5" library
Function GetDigitsInVariant(inputVariant As Variant) As Variant
' Returns:
' Only the digits found in a varaint.
' Examples:
' GetDigitsInVariant(Null) => Null
' GetDigitsInVariant("") => ""
' GetDigitsInVariant(2021-/05-May/-18, Tue) => 20210518
' GetDigitsInVariant(2021-05-18) => 20210518
' Notes:
' If the inputVariant is null, null will be returned.
' If the inputVariant is "", "" will be returned.
' Usage:
' VBA IDE Menu > Tools > References ...
' > "Microsoft VBScript Regular Expressions 5.5" > [OK]
' With an explicit object reference to RegExp we can get intellisense
' and review the object heirarchy with the object browser
' (VBA IDE Menu > View > Object Browser).
Dim regex As VBScript_RegExp_55.RegExp
Set regex = New VBScript_RegExp_55.RegExp
Dim result As Variant
result = Null
If IsNull(inputVariant) Then
result = Null
Else
With regex
.Global = True
.Pattern = "[^\d]+"
result = .Replace(inputVariant, vbNullString)
End With
End If
GetDigitsInVariant = result
End Function
Testing:
Private Sub TestGetDigitsInVariant()
Dim dateVariants As Variant
dateVariants = Array(Null, "", "2021-/05-May/-18, Tue", _
"2021-05-18", "18/05/2021", "3434 ..,sdf,sfd 444")
Dim dateVariant As Variant
For Each dateVariant In dateVariants
Debug.Print dateVariant & ": ", , GetDigitsInVariant(dateVariant)
Next dateVariant
Debug.Print
End Sub
Public Function ExtractChars(strRef$) As String
'Extract characters from a string according to a range of charactors e.g'+.-1234567890'
Dim strA$, e%, strExt$, strCnd$: strExt = "": strCnd = "+.-1234567890"
For e = 1 To Len(strRef): strA = Mid(strRef, e, 1)
If InStr(1, strCnd, strA) > 0 Then strExt = strExt & strA
Next e: ExtractChars = strExt
End Function
In the immediate debug dialog:
? ExtractChars("a-5d31.78K")
-531.78