VBA to expand a logical Text String – Revisited

[iantech]

The very elegant solution to this problem was previously posted in 2016 in this thread

It seemed to be the ideal solution for something I’m working on. However, it seems to fail in a specific situation and I’m not familiar enough with regexp code to figure it out.
The problem addressed was to expand a logical expression consisting of AND, OR logical expressions that may include parentheses. So for instance:

p AND (q OR r OR S ) becomes p AND q OR p AND r OR p AND s

i.e. p * (q + r + s) = p*q + p*r + p*s



The solution very cleverly replaced the OR/AND logic with arithmetic operators and with use of regular expressions got the correct results.

The problem seems to arise with the following type of input:

a * b * (c + d) should result in a*b*c + a*b*d

instead the code results in a*b*c + b*d


See original code here:

' PGC201609 - gets rid of parentheses in an algebraic expression with the operations "+" and "*"
' Ex.: (a*b+c)*(d+e) results in a*b*d+a*b*e+c*d+c*e
Function NoPar(ByVal s As String) As String
Dim regex1 As RegExp, regex2 As RegExp
Dim sMult As String
Dim v1 As Variant, v1Arr As Variant, v2 As Variant, v2Arr As Variant

' get rid of useless parentheses
Set regex1 = New RegExp
regex1.Pattern = "(^|[^*])\(([^()]+)\)(?!\*)"

' multiply with parentheses
Set regex2 = New RegExp
regex2.Pattern = "([^\(\)\+\*]+)\*\(([^\(\)]+)\)|\(([^\(\)]+)\)\*([^\(\)\+\*]+)|\(([^\(\)]+)\)\*\(([^\(\)]+)\)"
                                
s = Replace(s, " ", "")
Do
    Do While regex1.test(s): s = regex1.Replace(s, "$1$2"): Loop
    If Not regex2.test(s) Then Exit Do
    With regex2.Execute(s)(0)
        v1Arr = Split(.SubMatches(0) & .SubMatches(2) & .SubMatches(4), "+")
        v2Arr = Split(.SubMatches(1) & .SubMatches(3) & .SubMatches(5), "+")
        sMult = ""
        For Each v1 In v1Arr
            For Each v2 In v2Arr
                sMult = sMult & "+" & v1 & "*" & v2
            Next v2
        Next v1
        If Mid(s, .FirstIndex + .Length + 1, 1) = "*" Then sMult = "(" & Mid(sMult, 2) & ")" Else sMult = Mid(sMult, 2)
        s = Left(s, .FirstIndex) & sMult & Mid(s, .FirstIndex + .Length + 1)
    End With
Loop
NoPar = s
End Function

It would be great if there is someone who can help with this admittedly complex code.

Many thanks
IanH


EDIT:
Forgot to add that this needs the end user machine to set a reference to Microsoft VBScript Regular Expressions 5.5 in Tools references.
Also the solution appears to work with added parentheses :
a * b * (c + d) doesn't result in a*b*c + a*b*d
but
(a * b) * (c + d) does

 

[iantech]

Is there anyway to contact the poster who provided the original solution to the problem to suggest an approach to getting a fix for this?
I believe he is a MrExcel MVP named pgc01.

Thanks