Sorting String with Numbers using VB Script

Question

How to Sort String with Numeric values using VB Script?

Below are my strings from each row from a table:

1. "Test 1 pass dec 2"
2. "Test 3 fail"
3. "Test 2 pass jun 4"
4. "Verified"
5. "Test 10 pass"
6. "User Accepted"

I would to like get in below order after sorting(natural order):

1. "Test 1 pass dec 2"
2. "Test 2 pass jun 4"
3. "Test 3 fail"
4. "Test 10 pass"
5. "User Accepted"
6. "Verified"

Ways i have tried so far,

Set oAlist=CreateObject("System.Collections.ArrayList")
oAlist.sort

The ArrayList was sorted in below order based on ASCII which I do not prefer:

1. "Test 1 pass dec 2"
2. "Test 10 pass"
3. "Test 2 pass jun 4"
4. "Test 3 fail"
5. "User Accepted"
6. "Verified"

I have tried this link Sort

and i have no idea how to use AppendFormat in my case.

Note:My given string either completely string or string with numbers(dynamic) so not sure how to use RecordSet or AppendFormat here as I am new to programming.

Answer 1

To apply the techniques from here to the problem (using Split instead of a RegExp):

Option Explicit

Dim aInp : aInp = Array( _
      "Test 1 pass dec 2" _
    , "Test 3 fail" _
    , "Test 2 pass jun 4" _
    , "Verified" _
    , "Test 10 pass" _
    , "User Accepted" _
)
WScript.Echo "----- Input:", vbCrLf & Join(aInp, vbCrLf)
Dim aOtp : aOtp = Array( _
      "Test 1 pass dec 2" _
    , "Test 2 pass jun 4" _
    , "Test 3 fail" _
    , "Test 10 pass" _
    , "User Accepted" _
    , "Verified" _
)
WScript.Echo "----- Expected:", vbCrLf & Join(aOtp, vbCrLf)

Dim oNAL : Set oNAL = CreateObject( "System.Collections.ArrayList" )
Dim oSB  : Set oSB  = CreateObject( "System.Text.StringBuilder" )
Dim sInp, aParts, aWTF
For Each sInp In aInp
    aParts = Split(sInp, " ", 3)
    Select Case UBound(aParts)
      Case 0 ' add 2 blank elms to "verified"
        aWTF = aParts
        ReDim Preserve aWTF(2)
      Case 1 ' put an empty elm in the middle
        ' aParts = Array( aParts(0), "", aParts(1))
        ' ==> VBScript runtime error: This array is fixed or temporarily locked
        aWTF = Array( aParts(0), "", aParts(1))
      Case 2 ' What the doctor ordered
        aWTF = aParts
      Case Else
        Err.Raise "Shit hits fan"
    End Select
    oSB.AppendFormat_3 "{0}{1,4}{2}", aWTF(0), aWTF(1), aWTF(2)
    sInp = oSB.ToString() & "|" & sInp ' dirty trick: append org data th ease 'reconstruction'
    oSB.Length = 0
    oNAL.Add sInp
Next
oNAL.Sort

ReDim aOut(oNAL.Count - 1)
Dim i
For i = 0 To UBound(aOut)
    aOut(i) = Split(oNAL(i), "|")(1)
Next
WScript.Echo "----- Output:", vbCrLf & Join(aOut, vbCrLf)

output:

cscript 37946075.vbs
----- Input:
Test 1 pass dec 2
Test 3 fail
Test 2 pass jun 4
Verified
Test 10 pass
User Accepted
----- Expected:
Test 1 pass dec 2
Test 2 pass jun 4
Test 3 fail
Test 10 pass
User Accepted
Verified
----- Output:
Test 1 pass dec 2
Test 2 pass jun 4
Test 3 fail
Test 10 pass
User Accepted
Verified

Just for fun: The 'same', but using a RegExp (better scaling technique):

...
Dim r    : Set r    = New RegExp
r.Pattern = "^(\w+\s*)(\d+\s*)?(.*)$"
Dim sInp, m, aParts(2)
Dim i
For Each sInp In aInp
    Set m = r.Execute(sInp)
    If 1 = m.Count Then
       For i = 0 To 2
           aParts(i) = m(0).SubMatches(i)
       Next
     Else
        Err.Raise "Shit hits fan"
    End If
    oSB.AppendFormat_3 "{0}{1,4}{2}", aParts(0), aParts(1), aParts(2)
    sInp = oSB.ToString() & "|" & sInp ' dirty trick: append org data to ease 'reconstruction'
...

Answer 2

You can have another example.

Sub Sort
    Set rs = CreateObject("ADODB.Recordset")
    If LCase(Arg(1)) = "n" then
    With rs
        .Fields.Append "SortKey", 4 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
            If IsNumeric(Sortkey) = False then
                Set RE = new Regexp
                re.Pattern = "[^0-9\.,]"
                re.global = true
                re.ignorecase = true
                Sortkey = re.replace(Sortkey, "")
            End If
            If IsNumeric(Sortkey) = False then
                Sortkey = 0
            ElseIf Sortkey = "" then
                Sortkey = 0
            ElseIf IsNull(Sortkey) = true then
                Sortkey = 0
            End If
            .AddNew
            .Fields("SortKey").value = CSng(SortKey)
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With

    ElseIf LCase(Arg(1)) = "d" then
    With rs
        .Fields.Append "SortKey", 4 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
            If IsDate(Sortkey) = False then
                Set RE = new Regexp
                re.Pattern = "[^0-9\\\-:]"
                re.global = true
                re.ignorecase = true
                Sortkey = re.replace(Sortkey, "")
            End If
            If IsDate(Sortkey) = False then
                Sortkey = 0
            ElseIf Sortkey = "" then
                Sortkey = 0
            ElseIf IsNull(Sortkey) = true then
                Sortkey = 0
            End If
            .AddNew
            .Fields("SortKey").value = CDate(SortKey)
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With


    ElseIf LCase(Arg(1)) = "t" then
    With rs
        .Fields.Append "SortKey", 201, 260 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
            .AddNew
            .Fields("SortKey").value = SortKey
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With
    ElseIf LCase(Arg(1)) = "tt" then
    With rs
        .Fields.Append "SortKey", 201, 260 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Trim(Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3))))
            .AddNew
            .Fields("SortKey").value = SortKey
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With
    End If
End Sub

Answer 3

Since you are working with strings, you are going to need to write a custom sort function that can parse the test numbers from the strings.

Alternatively, you could pre-process your list and parse the numbers into a separate field, then sort based on that field.