I am programming a kind of parser which reads an Excel table and then creates a
List of processes with some properties like Name, StartTime, EndTime etc.
For this I have a class Process and in the main file, I have a processList (Scripting.Dictionary), where I put the processes as I read the lines... For this assignment, the key is a String called MSID.
Now the problem is that for some reason, I am only able to access the Object from the Dictionary and alter its parameters inside one part of my If-ElseIf statement. In the other case, it throws 424-object required error and I have no idea why.
Here is the code
Sub ParseMessages()
' ITERATOR VARIABLES
Dim wb As Workbook, ws As Worksheet
Dim rowIter As Long, row As Variant
Dim A As Variant, B As Variant, C As Variant, D As Variant, E As Variant, F As Variant ' A,B,C,D,E,F variables for the cells of each row
' PROCESS PARAMETERS
Dim MSID As Variant
Dim StartTime As Variant
Dim EndTime As Variant
' OBJECTS
Dim process As process
Dim processList As Scripting.Dictionary ' DICTIONARY where the error happens
Set processList = New Scripting.Dictionary
Worksheets(1).Activate
'####### MAIN LOOP ######################################################
For rowIter = 1 To 11
row = Rows(rowIter)
A = row(1, 1)
B = row(1, 2)
C = row(1, 3)
D = row(1, 4)
E = row(1, 5)
F = row(1, 6)
Dim startIndex As Long, endIndex As Long, count As Long
' ------ PROCESSSTART -> MSID, processName, startTime
If (.....) Then
Debug.Print (vbNewLine & "Process start")
If (...) Then ' --MSID
startIndex = InStr(F, "Nr") + 3 '3 to skip "Nr "
endIndex = InStr(startIndex, F, "(")
count = endIndex - startIndex
MSID = Mid(F, startIndex, count)
StartTime = B
Debug.Print (StartTime & " -> " & MSID)
' **** MAKE new Process object, add to collection
Set process = New process
process.StartTime = StartTime
process.MSID = MSID
processList.Add MSID, process ' Add to the dictionary, KEY, VALUE
ElseIf (...) Then ' --ProcessName
startIndex = InStr(F, "=") + 2
endIndex = InStr(F, "<") - 1
count = endIndex - startIndex
processName = Mid(F, startIndex, count)
Debug.Print (processName)
' **** Add Name to the last element of the dictionary
processList(processList.Keys(processList.count - 1)).Name = processName 'get last Process Object
processList(MSID).Name = "Just Testing" ' !!!! here it works
Else
End If
' ------ END OF PROCESS ->
ElseIf (......) Then
startIndex = InStr(D, "MSID") + 5
endIndex = InStr(startIndex, D, "]")
count = endIndex - startIndex
MSID = Mid(D, startIndex, count)
EndTime = B
Debug.Print (EndTime & " End of process " & MSID)
' **** Add End time for the process from the collection, specified by MSID
Debug.Print ("Test of " & processList(MSID).Name) ' !!!!! Doesn't work
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
processList(MSID).EndTime = EndTime ' !!!!! Does not work
End If
Next
End Sub
So to specify the question - why is it that this works:
processList(MSID).Name = "Just Testing" ' !!!! here it works
And this doesn't:
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
If I first prove if the Object with the MSID key exists in the dictionary,
it's not found.
If processList.Exists(MSID) Then
Debug.Print ("Process exists, altering it...")
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
processList(MSID).EndTime = EndTime
End If
But on the very first line where the condition is evaluated, I get something different by debug. It's THERE! See picture below
Debugging - MSID there but not able to access Dictionary entry with this as a key
Can you suggest how to solve this issue?
Thank you very much in advance for your help!
So... It's a bit shameful but after some hours of trying to solve this problem I found out,
that I added the Object to the list with MSID="124 " as Key.
When I tried to access, I of course used MSID with value "124".
Notice the difference? Yes, that space at the end.
The tricky part is - VBA debugger trims spaces at the end of Strings,
so it's actually impossible to see it. The same situation is if you print this out - impossible to see...
So in the end, I spent many hours looking for the answer, which is so simple :/
All I can do is to laugh about this.
Related
Very new to VBA coding. I inserted a Text Box (Active Control X) in my worksheet. Wrote a code to import data from MS Access database and save that data to an array. Later I am trying to print that array in the text box for user to see. but everytime my code enters the nested part of For loop, the running iteration of sub jumps back to the start of the code. Code than runs for multiple times make multiple SQL queries and excel crashes. I am not sure why code is jumping back to start of the sub?
Private Sub TextBox1_Change()
Dim sQuery As String
Dim ReturnData() As Variant
'Clear existing data in statuses area
Dim rngClearArea As Range
Dim wsFleetio As Worksheet
Set wsFleetio = ThisWorkbook.Worksheets("Test")
Dim Farm As String
Farm = wsFleetio.Range("B1").Value
'Set rngClearArea = FindTag(wsFleetio, "$Vehicle Status", 2, 0).Resize(1000, 4)
'rngClearArea.ClearContents
'Build query
sQuery = "SELECT [KillDate], [FarmName], [LoadType] FROM Loads WHERE ([FarmName] = '" & Farm & "' AND [KillDate] >= DateAdd('yyyy', -1, Date()))"
ReturnData = GetMerlinData(sQuery)
Dim leng As Integer
leng = UBound(ReturnData, 2)
Dim FarmData(500, 2) As Variant
Dim m As Integer
For m = 0 To UBound(ReturnData, 2)
FarmData(m, 0) = ReturnData(0, m)
FarmData(m, 1) = ReturnData(1, m)
FarmData(m, 2) = ReturnData(2, m)
Next
Dim i As Long, j As Long
For i = 0 To UBound(ReturnData, 2)
For j = 0 To 2
TextBox1.Text = TextBox1.Text & FarmData(i, j) & "---"
Next j
TextBox1.Text = TextBox1.Text & vbCrLf
Next i
End Sub
After running the first iteration of j, code jumps back to start of the code. I want it to run normally but not sure what the error is
Add a second TextBox, TextBox2 and use it in the loop: TextBox2.Text = TextBox2.Text & ...
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'm attempting to populate a 3d array and (at this point) simply return it in msgbox, the data I want in the array is in colums 9, 15 and 16 and would be like...
2342341234, 01/01/1969, 18:00
I keep getting a type mismatch and cannot fathom why, please help if you can, all suggestions welcome as I'm a novice at this stuff
Option Explicit
Global NumberOfRows As Integer
Global FirstRowOfData As Integer
Global LastRowOfData As Integer
Global i As Integer 'row loop
Global HospNo() As Integer
Global TRCDate() As Date
Global TRCTime() As Date
Global MonthArray(HospNo, TRCDate, TRCTime)
Sub CreateMonthArray()
FirstRowOfData = 1
With ActiveSheet
LastRowOfData = Range(.Range("A1"), .Range("A65535").End(xlUp)).Count
End With
Dim MonthArray(HospNo, TRCDate, TRCTime)
For i = FirstRowOfData To NumberOfRows
Let MonthArray(HospNo) = (ActiveSheet.Cells(i + 1, 9).value)
Let MonthArray(TRCDate) = (ActiveSheet.Cells(i + 1, 15).value)
Let MonthArray(TRCTime) = (ActiveSheet.Cells(i + 1, 16).value)
MsgBox MonthArray(HospNo(i), TRCDate(i), TRCTime(i))
Next i
End Sub
Many thanks.
This is not a full discussion of how to create and populate a 3D array of these values, rather just pointing out where your errors are in the code you have presented, which is just creating a single line.
I suspect your error comes on the Global or Dim MonthArray statements. In VBA, Arrays don't have "named" arguments. If that is the issue, you might try something like:
Global MonthArray(0 to 2) as Variant
and then, in your code:
MonthArray(0) = (ActiveSheet.Cells(i + 1, 9).value)
MonthArray(1) = (ActiveSheet.Cells(i + 1, 15).value)
MonthArray(2) = (ActiveSheet.Cells(i + 1, 16).value)
If you want to use Named Arguments (which can be real convenient for debugging, you probably should define a Class object.
In VBA, I usually use Public and not Global; and you should eliminate your duplicate declaration of MonthArray in the body of your code. Also, the Let statement is optional.
You also need to ensure that your NumberOfRows variable is set to a value somewhere. It is not set to anything within this module but, since it is a Public variable, you might be setting it elsewhere.
Finally, your MsgBox statement should be accessing the data in MonthArray by the index number. EG:
MsgBox MonthArray(0) & ", " & MonthArray(1) & "m " & MonthArray(2)
Thank you Ron, I can't tell you how long I spent trying to get that working without humiliating myself here. I'd upvote this if I could... With your notes, the working code is below
Option Explicit
Public NumberOfRows As Integer
Public FirstRowOfData As Integer
Public LastRowOfData As Integer
Public i As Integer 'row loop
'Public HospNo() As Integer
'Public TRCDate() As Date
'Public TRCTime() As Date
Public MonthArray(0 To 2) As Variant
Sub CreateMonthArray()
FirstRowOfData = 1
With ActiveSheet
LastRowOfData = Range(.Range("A1"), .Range("A65535").End(xlUp)).Count
End With
'Dim MonthArray(HospNo, TRCDate, TRCTime)
For i = FirstRowOfData To LastRowOfData
MonthArray(0) = (ActiveSheet.Cells(i + 1, 9).value)
MonthArray(1) = (ActiveSheet.Cells(i + 1, 15).value)
MonthArray(2) = (ActiveSheet.Cells(i + 1, 16).value)
MsgBox MonthArray(0) & ", " & MonthArray(1) & ", " & MonthArray(2)
Next i
End Sub
I have one text file that contains around 100K lines. Now I would like to search a string from the text file. If that string is present then I want to get the line number at which it's present. At the end I need all the occurrence of that string with line numbers from the text file.
* Ordinary Method Tried *
We can read the whole text file line by line. Keep a counter variable that increases after every read. If I found my string then I will return the Counter Variable. The limitation of this method is, I have to traverse through all the 100K lines one by one to search the string. This will decrease the performance.
* Quick Method (HELP REQUIRED)*
Is there any way that will directly take me to the line where my searchstring is present and if found I can return the line number where it's present.
* Example *
Consider below data is present in text file. (say only 5 lines are present)
Now I would like to search a string say "Pune". Now after search, it should return me Line number where string "pune" is present. Here in this case it's present in line 2. I should get "2" as an output. I would like to search all the occurrence of "pune" with their line numbers
I used a spin off of Me How's code example to go through a list of ~10,000 files searching for a string. Plus, since my html files have the potential to contain the string on several lines, and I wanted a staggered output, I changed it up a bit and added the cell insertion piece. I'm just learning, but this did exactly what I needed and I hope it can help others.
Public Sub ReadTxtFile()
Dim start As Date
start = Now
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFS As Object
Dim filePath As String
Dim a, b, c, d, e As Integer
a = 2
b = 2
c = 3
d = 2
e = 1
Dim arr() As String
Do While Cells(d, e) <> vbNullString
filePath = Cells(d, e)
ReDim arr(5000) As String
Dim i As Long
i = 0
If oFSO.FileExists(filePath) Then
On Error GoTo Err
Set oFS = oFSO.OpenTextFile(filePath)
Do While Not oFS.AtEndOfStream
arr(i) = oFS.ReadLine
i = i + 1
Loop
oFS.Close
Else
MsgBox "The file path is invalid.", vbCritical, vbNullString
Exit Sub
End If
For i = LBound(arr) To UBound(arr)
If InStr(1, arr(i), "Clipboard", vbTextCompare) Then
Debug.Print i + 1, arr(i)
Cells(a + 1, b - 1).Select
Selection.Insert Shift:=xlDown
Cells(a, b).Value = i + 1
Cells(a, c).Value = arr(i)
a = a + 1
d = d + 1
End If
Next
a = a + 1
d = d + 1
Loop
Debug.Print DateDiff("s", start, Now)
Exit Sub
Err:
MsgBox "Error while reading the file.", vbCritical, vbNullString
oFS.Close
Exit Sub
End Sub
the following fragment could be repalaced like:
Dim arr() As String
Dim i As Long
i = 0
If oFSO.FileExists(filePath) Then
On Error GoTo Err
Set oFS = oFSO.OpenTextFile(filePath)
Do While Not oFS.AtEndOfStream
ReDim Preserve arr(0 To i)
arr(i) = oFS.ReadLine 'to save line's content to array
'If Len(oFSfile.ReadLine) = 0 Then Exit Do 'to get number of lines only
i = i + 1
Loop
oFS.Close
Else
MsgBox "The file path is invalid.", vbCritical, vbNullString
Exit Sub
End If
Here's another method that should work fairly quickly. It uses the shell to execute the FINDSTR command. If you find the cmd box flickers, do an internet search for how to disable it. There are two options provided: one will return the line number followed by a colon and the text of the line containing the keyword. The other will just return the line number.
Not sure what you want to do with the results, so I just have them in a message box.
Option Explicit
'Set reference to Windows Script Host Object Model
Sub FindStrings()
Const FindStr As String = "Pune"
Const FN As String = "C:\users\ron\desktop\LineNumTest.txt"
Dim WSH As WshShell
Dim StdOut As Object
Dim S As String
Set WSH = New WshShell
Set StdOut = WSH.Exec("cmd /c findstr /N " & FindStr & Space(1) & FN).StdOut
Do Until StdOut.AtEndOfStream
S = S & vbCrLf & StdOut.ReadLine
'If you want ONLY the line number, then
'S = S & vbCrLf & Split(StdOut.ReadLine, ":")(0)
Loop
S = Mid(S, 2)
MsgBox (S)
End Sub
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