VBA, How to pass in a string argument, convert to single character array and resize according to non-numerical values?

Question

Ok,

To all those who may come across this question, this is a problem I have been banging my head against for the past two weeks and have made little or no progress, so any help would be extremely welcome.

Here's the set up; then I will follow with an excerpt of the code I have written:

I am writing a function to get a very specific formula for each file name in a given folder. This naturally requires me to write a program which can take string arguments (in this case, excel file names) from a very broad domain of possibilities and yield a very specific output based on some key -and highly unique- parameters. Hence, my function is bijective and the set of arguments and set of products are massive; therefore, I am in the process of writing a sub-process for this function which partitions the string argument, by character, into a corresponding array, remove all the unnecessary characters, concatenate the remaining characters into the output string, and then go through a series of checks to enforce whatever name-formula the file requires. For now, I am just focused on splitting the string into an array, removing all non-numeric characters and combining the remaining characters back into a single string.

Naturally, I have tried the split function, but to my knowledge VBA doesn't support the splitting of a string into single characters. So I have written the following code, which, admittedly, is a bit inelegant, but I think in principle must work. -It does not. Would someone kindly tell me why it doesn't, and make a recommendation for altering it.

Dim arr() As Variant
        For i = Len(strArg) To i = 1
            If IsNumeric(Mid$(strArg, i, 1)) = True Then
            arr(i - 1) = Mid$(strArg, i, 1)
            Else: arr(i - 1) = ""
            End If
        Next
    newStr = Join(arr())

arr() always returns empty, so newStr is always "". Yet there are always numeric values in each string argument. -I can't imagine why I am getting this result. If I use ReDim arr(Len(strArg)), I get Len(strArg) number of " " back....

Thanks in advance to whomever may provide help.

Answer 1

Not sure why you need to split it into an array for this. Your description says you only want to have numeric characters returned in a new string variable. A function like this should work for you:

Function GetNumbers(ByVal arg_sText As String) As String
    
    Dim i As Long
    Dim sChar As String
    Dim sNumbers As String
    
    For i = 1 To Len(arg_sText)
        sChar = Mid(arg_sText, i, 1)
        If IsNumeric(sChar) Then sNumbers = sNumbers & sChar
    Next i
    
    GetNumbers = sNumbers
    
End Function

Then just call it in your code like this:

newStr = GetNumbers(strArg)  'Example: "ab1c2d" = "12"

Answer 2

Alternatively use a Regular Expression

Function NumOnly(s As String) As String
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        .Pattern = "[^0-9]+"
         NumOnly = .Replace(s, "")
    End With  
End Function

Answer 3

As a further approach to the existing solutions, I'd like to demonstrate how to use the ►FilterXML() function and to check valid results.

The proposed function NumsOnly() consists only of three steps:

• a) execute an XPath search upon xml content which has been created by getXML()
• b) check valid results via procedure check
• c) return the function result as new formed string

Coming close to the requirements in OP this includes also a way to convert a string to a single character array (c.f. @JNevill 's comment to OP) and to build a well-formed xml string as base for Filter.XML (see function getXML()) .

Main function NumsOnly()

Function NumsOnly(ByVal s As String) As String
'Purp: recognizes only numeric values in comparisons
'Note: no findings and single digit results are handled by proc check
    Const xpath As String = "//*[.>0]"  ' get only digits out of atomized characters
'a) execute XPath search upon xml content
    Dim x: x = Application.FilterXML(getXML(s), xpath)
'b) check valid results
    check x
'c) return only-nums string as function result
    NumsOnly = x
End Function

Helper function getXML()

Extended udf based on Split string into array of characters?

Function getXML(ByVal s As String)
'Purp: return well-formed xml content string as base for FilterXML function
'1) atomize string elements into array
    Dim buff() As String: buff = Split(StrConv(s, vbUnicode), Chr$(0))
    ReDim Preserve buff(UBound(buff) - 1)
'2) return valid xml content string
    getXML = "<ch><c>" & Join(buff, "</c><c>") & "</c></ch>"
End Function

Procedure check

As FilterXML returns findings of more than one element as a 2-dim array, non-findings as Error 2015 and a single element as stand-alone value, it is necessary to distinguish between the returned var types:

Sub check(ByRef x, Optional ErrorResult As String = "")
'Purp: provide for correct xml result by checking var types
    Select Case VarType(x)
        Case vbError        ' non-findings (Error 2015)
            x = ErrorResult
        Case Is >= vbArray  ' 2-dim results (if more than 1 element)
            x = Join(Application.Transpose(x), vbNullString)
        'Case Else          ' single element (here: digit, i.e. Double)
    End Select
End Sub