Need ideas on VBA to randomly select words in string

[Ceeyee]

Hi,

Say I have a string

"I {would like to|want to|love to} do {it|that}."

What is the fastest way to make a function to randomly choose a selection within each {} and returns a random string such as "I want to do that."

Any ideas? Thanks.

 

[Ceeyee]

It seems like it will be very complicated to handle nested {}. I will try my best to figure that out.

 

[mikerickson]

I think this will do what you want.
The logic is similar to compiling/interpreting a formula string in regard to parenthesis.
Note the alwaysChoose argument that will aways choose the n'th option. If omitted (or <1) it will return a random sub string.
More error coding should be added to handle strings like "cat}fish{goat" and other oddities.

Function RandomSubStrings(ByRef aString As String, Optional alwaysChoose As Long = -1)
    Const LMark As String = "{"
    Const RMark As String = "}"
    Const ChoiceSep As String = "|"
    Dim startChr As Long
    Dim preString As String, bracketedString As String, postString As String
    Dim Phrases As Variant
    Dim Index As Long, MarkCount As Long

    If Len(Replace(aString, LMark, vbNullString)) <> Len(Replace(aString, RMark, vbNullString)) Then RandomSubStrings = "missing {}": Exit Function

    startChr = InStr(1, aString, LMark)
    If startChr = 0 Then
        Rem choose among options
        Phrases = Split(aString, ChoiceSep)
        If alwaysChoose < 1 Then
            RandomSubStrings = Phrases(Int(Rnd() * (UBound(Phrases) + 1)))
        Else
            RandomSubStrings = Phrases(Application.Min(UBound(Phrases), alwaysChoose - 1))
        End If
        Exit Function
    Else
        For Index = startChr To Len(aString)
            MarkCount = MarkCount + (Mid(aString, Index, 1) = RMark) - (Mid(aString, Index, 1) = LMark)
            If MarkCount = 0 Then Exit For
        Next Index

        preString = Left(aString, startChr - 1)
        bracketedString = Mid(aString, startChr + 1, Index - startChr - 1)
        postString = Mid(aString, Index + 1)

        RandomSubStrings = RandomSubStrings(preString & RandomSubStrings(bracketedString, alwaysChoose) & postString, alwaysChoose)
    End If
End Function

 

[Ceeyee]

You are amazing!!!!!!!!! Thank you.

I am adding an alwaysChoose = 0 option to make it so that with this option =0 it always chooses starting from the second item (unless there's only one item in the {}).
But I am getting #Value from this small modification, why?

If alwaysChoose = -1 Then
RandomSubStrings = Phrases(Int(Rnd() * (UBound(Phrases) + 1)))
ElseIf alwaysChoose = 0 And UBound(Phrases) >= 1 Then
RandomSubStrings = Phrases(Int(1 + Rnd() * (UBound(Phrases))))
Else
RandomSubStrings = Phrases(Application.Min(UBound(Phrases), alwaysChoose - 1))
End If


By the way, your code actually handles "cat}fish{goat" very well already. Amazing..

 

[mikerickson]

I think that the alwaysChoose argument is more intuitive if

alwaysChoose = 1 always returns the first option
alwaysChoose = 2 always returns the second option, etc.

alwaysChoose <=0 would then return a randomly chosen element.

If you are going to use 2 often, you could make it the default value of the optional alwaysChoose.

This version does that. I also optimized a bit and added comments.

=RandomSubStrings("The start {abc|123} {goat|{fish|cat|hamster} of end.")
will return "The start 123 cat of end.".

=RandomSubStrings("The start {abc|123} {goat|{fish|cat|hamster} of end.", 0) will return randomly chosen options.

Function RandomSubStrings(ByRef aString As String, Optional alwaysChoose As Long = 2) As String
    Const LBracket As String = "{"
    Const RBracket As String = "}"
    Const ChoiceSeparator As String = "|"
    
    Dim startPosition As Long
    Dim strBefore As String, strBracketed As String, strAfter As String
    Dim strReAssembled As String
    Dim Phrases As Variant
    Dim Index As Long, MarkCount As Long

    Rem find position of first left bracket
    startPosition = InStr(1, aString, LBracket)
    
    If 0 < startPosition Then
        Rem find position of matching right bracket
        For Index = startPosition To Len(aString)
            MarkCount = MarkCount + (Mid(aString, Index, 1) = RBracket) - (Mid(aString, Index, 1) = LBracket)
            If MarkCount = 0 Then Exit For
        Next Index
        
        Rem parse string at bracket locations
        strBefore = Left(aString, startPosition - 1)
        strBracketed = Mid(aString, startPosition + 1, Index - startPosition - 1)
        strAfter = Mid(aString, Index + 1)
        
        Rem evaluate bracketed portion
        strReAssembled = strBefore & RandomSubStrings(strBracketed, alwaysChoose) & strAfter
        
        Rem do it again, in order to process the next remaining left bracket
        RandomSubStrings = RandomSubStrings(strReAssembled, alwaysChoose)
    Else
        Rem no brackets in string
        Rem choose among pipe (|) delimited substrings
        Phrases = Split(aString, ChoiceSeparator)
        
        Index = Application.Min(alwaysChoose - 1, UBound(Phrases))
        If Index < 0 Then Index = Int(Rnd() * (UBound(Phrases) + 1))
        RandomSubStrings = Phrases(Index)
    End If
End Function

 

[mikerickson]

There is an error in the code in post #14.

Function RandomSubStrings(ByRef aString As String, Optional ByVal alwaysChoose As Long = 2) As String
    Const LBracket As String = "{"
    Const RBracket As String = "}"
    Const ChoiceSeparator As String = "|"
    
    Dim startPosition As Long
    Dim strBefore As String, strBracketed As String, strAfter As String
    Dim strReAssembled As String
    Dim Phrases As Variant
    Dim Index As Long, MarkCount As Long

    Rem find position of first left bracket
    startPosition = InStr(1, aString, LBracket)
    
    If 0 < startPosition Then
        Rem find position of matching right bracket
        For Index = startPosition To Len(aString)
            MarkCount = MarkCount + (Mid(aString, Index, 1) = RBracket) - (Mid(aString, Index, 1) = LBracket)
            If MarkCount = 0 Then Exit For
        Next Index
        
        Rem parse string at bracket locations
        strBefore = Left(aString, startPosition - 1)
        strBracketed = Mid(aString, startPosition + 1, Index - startPosition - 1)
        strAfter = Mid(aString, Index + 1)
        
        Rem evaluate bracketed portion
        strReAssembled = strBefore & RandomSubStrings(strBracketed, alwaysChoose) & strAfter
        
        Rem do it again, in order to process the next remaining left bracket
        RandomSubStrings = RandomSubStrings(strReAssembled, alwaysChoose)
    Else
        Rem no brackets in string
        Rem choose among pipe (|) delimited substrings
        Phrases = Split(aString, ChoiceSeparator)
        If alwaysChoose < 1 Then
            Index = Int(Rnd() * (UBound(Phrases) + 1))
        Else
            Index = Application.Min(alwaysChoose - 1, UBound(Phrases))
        End If
        RandomSubStrings = Phrases(Index)
    End If
End Function

 

[Ceeyee]

Fantastic!!
You have been a great help. Really appreciate it!