2

I'm reasonably new to VBA so I apologise if I've missed a solution out there. Been googling but haven't come across this type of scenario.

I have a piece of software that spits out a list of elements as a string of text in the format below, as an example:

1 2 5to7 9 10to14by2

This string essentially represents the numbers 1, 2, 5, 6, 7, 9, 10, 12, 14

I am trying to work out a way in VBA (or base Excel 365 if it's simpler, which I doubt) to convert the original string into the full list of numbers it represents.

I'm not fussed on the output format in terms of if it ends up as another string, or an array etc. I believe I can learn how to manipulate it further from there. I just can't wrap my head around how I might turn 5to7 into 5, 6, 7 and 10to14by2 into 10, 12, 14.

I worked out how to split the original string up into sections with the "Split" function but that's about as far as I got. That would allow me to generate a list if it were all single numbers, but because of the "to" statements, I can't generate the full list.

Any direction would be greatly appreciated.

EDIT* Thank you for all the prompt solutions. They all got me the outputs that were required. Appreciate seeing different sets of code as it gives me more exposure on how to approach similar problems in the future.

Radie
  • 23
  • 5

3 Answers3

3

The attempt to use split is correct - that will create a list of "words" (you call them "sections"). Now you need to solve 2 problems: First is to handle those sections, the second is how to combine the results.

As VBA is rather poor in dynamic arrays, I have chosen to use a Dictionary for that. As I always advocate for early binding, you will need to add a reference to the "Scripting.Library", see Does VBA have Dictionary Structure?.

To handle a section, have a closer look to it: Every section starts with a number, optional followed by "to" and another number, optional followed by "by" and a third number. When you replace those keywords with spaces, "10to14by2" would result in "10 14 2". Now use split another time and you have the values you need for a For-loop: Start Value, End Value and Step Value.

To keep the code simple, I assume that there are no syntax errors in the input (eg no other characters, extra spaces...). If this is not the case, you will need to think about error handling.

The following code uses two functions: One to split the input string into sections and loop over this sections, the second to handle a single section. I think the code is rather easy to understand:

Function CreateNumberVector(s As String) As Dictionary
    Dim dict As Dictionary
    Set dict = New Dictionary
    
    Dim sections() As String, i As Long
    sections = Split(s, " ")
    For i = LBound(sections) To UBound(sections)
        handleSection dict, sections(i)
    Next i
    
    Set CreateNumberVector = dict

End Function

Sub handleSection(dict As Dictionary, ByVal section As String)
    ' Input: 10to14by2
    ' Output: 10, 12, 14 added to dict
    section = Replace(section, "to", " ")
    section = Replace(section, "by", " ")
    Dim tokens() As String
    tokens = Split(section, " ")

    ' Now we have an array 10, 14, 2       
    Dim fromVal As Long, toVal As Long, stepVal As Long
    fromVal = Val(tokens(0))      ' Startvalue for the loop
    If UBound(tokens) > 0 Then    ' Endvalue for the loop
        toVal = Val(tokens(1))
    Else
        toVal = fromVal           ' If nothing provided, Endvalue=Startvalue
    End If
    
    If UBound(tokens) > 1 Then    ' Step for the loop
        stepVal = Val(tokens(2))
    Else
        stepVal = 1               ' If nothing provided, step=1
    End If
    
    ' Now execute the loop and add the values to the dictionary
    Dim n As Long
    For n = fromVal To toVal Step stepVal
        dict(n) = n
    Next
End Sub

To test it:

Sub test()
    Const s = "1 2 5to7 9 10to14by2"
    Dim dict As Dictionary
    Set dict = CreateNumberVector(s)
    Debug.Print Join(dict.Keys, ", ")
End Sub

Will print 1, 2, 5, 6, 7, 9, 10, 12, 14 to the immediate window.

Note that the dictionary is unsorted and will spit out the keys in the order they are added, so an Input of "3, 10, 5to7" would result in "3, 10, 5, 6, 7". If you need those sorted, search for "Sorting a Dictionary by Keys".

FunThomas
  • 23,043
  • 3
  • 18
  • 34
  • Did you forget to include `addNumbersToDict`? – CLR Jul 04 '23 at 09:20
  • @CLR: Made some last minute changes in naming - corrected-. Thanks for pointing out – FunThomas Jul 04 '23 at 09:24
  • Hi FunThomas, thank you for the solution. It's doing exactly what I needed. It's not necessary for the numbers be sorted at this stage, so it's all good, but I appreciate you pointing me in the direction for if I need to do so in the future. – Radie Jul 04 '23 at 10:16
2

Retrieve Integers From Special String

enter image description here

The Test

Sub GetNumbersTEST()

    Const SpecialString As String = "1 2 7to5 9 14to10by2"
    
    Dim Numbers As Variant: Numbers = GetNumbers(SpecialString)
    
    If IsEmpty(Numbers) Then
        MsgBox "The supplied string """ & SpecialString & """ is invalid.", _
            vbCritical
    Else
        MsgBox Join(Numbers, ", ")
    End If

End Sub

The Function

Function GetNumbers( _
    ByVal SpecialString As String, _
    Optional ByVal TermDelimiter As String = " ", _
    Optional ByVal RangeDelimiter As String = "to", _
    Optional ByVal StepDelimiter As String = "by") _
As Variant

    If Len(SpecialString) = 0 Then Exit Function

    Dim Terms() As String: Terms = Split(SpecialString, TermDelimiter)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim rArr, sArr, Term, n As Long, pRange As Long, pStep As Long
    Dim First As Long, Last As Long, Step As Long
    
    For Each Term In Terms
        If IsNumeric(Term) Then
            dict(CLng(Term)) = Empty
        Else
            pRange = InStr(1, Term, RangeDelimiter, vbTextCompare)
            If pRange > 0 Then
                rArr = Split(Term, RangeDelimiter)
                If IsNumeric(rArr(0)) Then
                    First = CLng(rArr(0))
                    If IsNumeric(rArr(1)) Then
                        Last = CLng(rArr(1))
                        Step = IIf(First <= Last, 1, -1)
                    Else
                        pStep = InStr(1, rArr(1), StepDelimiter, vbTextCompare)
                        If pStep > 0 Then
                            sArr = Split(rArr(1), StepDelimiter)
                            If IsNumeric(sArr(0)) Then
                                Last = CLng(sArr(0))
                                If IsNumeric(sArr(1)) Then
                                    Step = IIf(First <= Last, _
                                        CLng(sArr(1)), -CLng(sArr(1)))
                                End If
                            End If
                        End If
                    End If
                End If
            End If
            If Step <> 0 Then
                For n = First To Last Step Step
                    dict(n) = Empty
                Next n
                Step = 0
            End If
        End If
    Next Term
                            
    If dict.Count > 0 Then
        GetNumbers = dict.Keys
    End If
                            
End Function
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • 1
    Hi Vbasic, thanks for the solution. Works as intended and was able to get the outputs I needed. Appreciate the time. – Radie Jul 04 '23 at 10:17
1

This solution expects the input string to contain only numbers, "to" elements (eg "5to6") or "to-by" elements (eg "10to20by5") ... each separated by a single space. Anything else will result in an error which the calling code will need to handle.

See comments in code for explanation of each step.

Function GetNumbers(inputText As String) As String
    Dim aTexts() As String
    ' split the supplied inputText into individual elements - assumes each element is split based on space chars
    aTexts = Split(inputText, " ")
    Dim outputText As String, i As Long
    ' iterate over each element
    For i = LBound(aTexts) To UBound(aTexts)
        ' if it is just a number then add it to the output text
        If IsNumeric(aTexts(i)) Then
            outputText = outputText & CStr(aTexts(i))
        Else
            ' otherwise it is a 'range' with 'to' and possible 'by'
            Dim indexTo As Long, indexBy As Long, fromNum As Long, toNum As Long, stepNum As Long
            indexTo = InStr(1, aTexts(i), "to", vbTextCompare)
            indexBy = InStr(1, aTexts(i), "by", vbTextCompare)
            fromNum = CLng(Left$(aTexts(i), indexTo - 1))
            If indexBy = 0 Then
                ' there is no 'by'
                toNum = CLng(Mid$(aTexts(i), indexTo + 2))
                stepNum = 1
            Else
                ' there is a 'by'
                toNum = CLng(Mid$(aTexts(i), indexTo + 2, indexBy - indexTo - 2))
                stepNum = CLng(Mid$(aTexts(i), indexBy + 2))
            End If
            ' add the number in the 'range'
            Dim j As Long
            For j = fromNum To toNum Step stepNum
                outputText = outputText & CStr(j) & IIf(j = toNum, vbNullString, ", ")
            Next j
        End If
        ' unless we have just added the very last number to the output text, add ", "
        If i < UBound(aTexts) Then
            outputText = outputText & ", "
        End If
    Next i
    ' return the output text
    GetNumbers = outputText
End Function

Example use:

Debug.Print GetNumbers("1 2 5to7 9 10to14by2")

Results in 1, 2, 5, 6, 7, 9, 10, 12, 14

JohnM
  • 2,422
  • 2
  • 8
  • 20