Extract Items from String and then Sort

[Leith Ross]

Hello swaggerbox,

This worked for the example you provided. I cannot guarantee that it will work 100% with your original data. Parsing complex strings is challenging due to the large number of arrangements of syntax and punctuation. Give it try and let me know your results.

The macro below has already been added to the attached workbook. Double Click anywhere in the Text Box and a message box will display the arsed results.

Module1 - Macro Code

Option Explicit


Function ParseItems(ByVal Text As String)


    Dim vArray  As Variant
    Dim Items   As Variant
    Dim j       As Long
    Dim k       As Long
    Dim Lookup  As Variant
    Dim LoToHi  As Boolean
    Dim n       As Long
    Dim RegExp  As Object
    Dim sorted  As Boolean
    Dim upBound As Long
    
        Set RegExp = CreateObject("VBScript.RegExp")
            RegExp.Global = True
            RegExp.IgnoreCase = False
            RegExp.Pattern = ".*(?:,|with|and|comprising)(.+)\((\d+)\)$"
        
        ' // Separate Items by their values into an array.
        vArray = Split(Text, ")")
        
        ReDim Items(0)  ' // Holds the Item strings.
        ReDim Lookup(0) ' // This array holds the index values of the Items array.
        
        ' // Parse the Item strings.
        For n = 0 To UBound(vArray)
            Text = vArray(n) & ")"     ' // Add the closing parenthesis since it was removed by Split.
            If RegExp.Test(Text) Then
                k = CLng(RegExp.Replace(Text, "$2"))   ' // Convert the value from aa string to a number.
                Lookup(j) = k               ' // Save Item number in the Lookup array.
                j = j + 1                   ' // Increment count of valid Items.
                ReDim Preserve Lookup(j)    ' // Increase the Lookup array by 1 element.
                If k > UBound(Items) Then
                    ReDim Preserve Items(k) ' // Increase the Items array index to the largest Item number.
                End If
                Items(k) = RegExp.Replace(Text, "($2) $1") ' // Save the string as "(value) Item description".
            End If
        Next n
        
        upBound = UBound(Lookup)
        
        ' // Sort the Lookup array in ascending order. Set LoToHi to True for descending sort order.
        Do
            sorted = True
                For j = 0 To upBound - 1
                    If Not IsEmpty(Lookup(j)) Then
                        If LoToHi Xor Lookup(j) > Lookup(j + 1) Then
                            k = Lookup(j + 1)
                            Lookup(j + 1) = Lookup(j)
                            Lookup(j) = k
                            sorted = False
                        End If
                    End If
                Next j
            upBound = upBound - 1
        Loop Until sorted Or upBound < 1
                
        Text = ""
        
        ' // Build the output string.
        For n = 0 To UBound(Lookup)
            k = Lookup(n)
            If Items(k) <> "" Then
                If Text = "" Then
                    Text = "<ITEMS>" & Items(k)
                Else
                    Text = Text & "#" & Items(k)
                End If
            End If
        Next n
        
        If Text <> "" Then Text = Text & "</ITEMS>"
        
        ParseItems = Text
        
End Function