Adjust vba excel script to sort entries in a column

I need to adjust the attached script so that is alpha sorts entries in the "addl_auths" field. Can somebody provide code that I can insert into the existing code to make that happen?

Original script attached as well as sample input.

Cheers!  031211pm.vbs sampleInput.csv
GessWurkerAsked:
Who is Participating?
 
gamarrojgqCommented:
ok, weird, that would means that you are using different functions for each field, I review the file you send me and is not longer using column K is using column L instead.

So change it to the real column where the addl_auths is.

The only  explanation would be that the process is calling the Function twice, one time return nothing, and the second time return the real value, so here it is on last modified version, try it and if does not remove the semi-colon, we will have to live with that ;)
031711pmFINALAGAIN.vbs
0
 
gamarrojgqCommented:
Hi,

If what you want is that this value in field addl_auths

Chang (D);Johanson (R);Cullen (D);Keith-Agaran (D);Aquino (D);Ward (R);Tokioka (D);Rhoads (D);Mizuno (D);McKelvey (D);Belatti (D);Pine (R);Chong (D);Nishimoto (D);Herkes (D);Ching (R);Souki (D);Riviere ®

Shows Sorted like this

Aquino (D);Belatti (D);Chang (D);Ching (R);Chong (D);Cullen (D);Herkes (D);Johanson (R);Keith-Agaran (D);McKelvey (D);Mizuno (D);Nishimoto (D);Pine (R);Rhoads (D);Riviere ®;Souki (D);Tokioka (D);Ward (R);

There are a couple of ways to do it, but Sorting a list is an iterative process that requires a fairly sophisticated algorithm, so one thing you can do is use Microsoft Active Data Objects

1.- Add in your VBA the reference to Microsoft Active Data Objects
2.- Add the attaced Function to your module
3.- use the function to return the Cell Value, something like this  Sheet1.Range("K2:K2").Value = SortText(Sheet1.Range("K2:K2").Value)

Hope that helps





Function SortText(strBase) As String

    Dim strSorted As String
    Dim vecBase() As String
   
    On Error GoTo ErrHandler
    
    Dim listad As New ADODB.Recordset
    Dim intIndex As Integer
    
    listad.Fields.Append "TextValue", 200, 100   'varchar type and 100 lenght
    listad.Open
    
    vecBase = Split(strBase, ";")
    For intIndex = 0 To UBound(vecBase)
        listad.AddNew
        listad("TextValue") = vecBase(intIndex)
        listad.Update
    Next
    
    listad.Sort = "TextValue"
    
    If listad.RecordCount > 0 Then
        listad.MoveFirst
    End If
    
    strSorted = ""
    Do While Not listad.EOF
        strSorted = strSorted & listad("TextValue") & ";"
        listad.MoveNext
    Loop
    
    SortText = strSorted
    Exit Function

ErrHandler:
    MsgBox Err.Description, vbCritical
    SortText = ""

End Function

Open in new window

0
 
GessWurkerAuthor Commented:
Hmm.. I'm not sure how to add the reference to Microsoft Active Data Objects.
0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

 
gamarrojgqCommented:
ok, sorry since you send a csv file I've believe you were using Excel VBA, so from where are you running the VB Script?
0
 
GessWurkerAuthor Commented:
I execute the script locally (via task manager, actually) on a scheduled basis. I'm running it on a server; it looks for a csv file in a particular folder and if a file is present, the script does its work.
0
 
GessWurkerAuthor Commented:
Note: There's a supporting file also. I've attached it. StateList.txt
0
 
gamarrojgqCommented:
Ok, then use this version of the function
0
 
gamarrojgqCommented:
Sorry here is the new version of the function
Function SortText(strBase) As String

    Dim strSorted As String
    Dim vecBase() As String
   
    On Error GoTo ErrHandler
    
    Dim listad As Object
    Set listad = CreateObject("ADODB.Recordset")
    Dim intIndex As Integer
    
    listad.Fields.Append "TextValue", 200, 100   'varchar type and 100 lenght
    listad.Open
    
    vecBase = Split(strBase, ";")
    For intIndex = 0 To UBound(vecBase)
        listad.AddNew
        listad("TextValue") = vecBase(intIndex)
        listad.Update
    Next
    
    listad.Sort = "TextValue"
    
    If listad.RecordCount > 0 Then
        listad.MoveFirst
    End If
    
    strSorted = ""
    Do While Not listad.EOF
        strSorted = strSorted & listad("TextValue") & ";"
        listad.MoveNext
    Loop
    
    SortText = strSorted
    Exit Function

ErrHandler:
    MsgBox Err.Description, vbCritical
    SortText = ""

End Function

Open in new window

0
 
GessWurkerAuthor Commented:
gamarrojgq:

I added your function to my code (at top), but the script doesn't get passed the first line. My script never gets to the point where it can even try calling the function. I get this error:

Script:  031511pm.vbs
Line:     2
Char:    28
Error:    Expected statement
Code:    800A0400
Source: Microsoft VBScript compilation error
0
 
gamarrojgqCommented:
ok, try this version
Function SortText(strBase)

    Dim strSorted
    Dim vecBase()
    
    Dim listad
    Set listad = CreateObject("ADODB.Recordset")
    Dim intIndex
    
    listad.Fields.Append "TextValue", 200, 100   'varchar type and 100 lenght
    listad.Open
    
    vecBase = Split(strBase, ";")
    For intIndex = 0 To UBound(vecBase)
        listad.AddNew
        listad("TextValue") = vecBase(intIndex)
        listad.Update
    Next
    
    listad.Sort = "TextValue"
    
    If listad.RecordCount > 0 Then
        listad.MoveFirst
    End If
    
    strSorted = ""
    Do While Not listad.EOF
        strSorted = strSorted & listad("TextValue") & ";"
        listad.MoveNext
    Loop
    
    SortText = strSorted

End Function

Open in new window

0
 
GessWurkerAuthor Commented:
Getting closer. Now we can call the function but it fails on this line:

vecBase = Split(strBase, ";")

The error:

Type mismatch: 'strBase'
0
 
gamarrojgqCommented:
ok try to change that line for this one

vecBase = Split(CStr(strBase), ";")
0
 
GessWurkerAuthor Commented:
Yes, I thought that might work too, but when I tried it:

Type mismatch: 'Cstr'
0
 
gamarrojgqCommented:
ok, are you sure you are passing a value to the function? I mean in you script there is a place where you are calling the function? something like

strSomething = SortText(strOtherVariable)

If you have it, try to move the function to the end of the file
0
 
GessWurkerAuthor Commented:
See attached script. Line 132 is where I'm trying to call your function. 031611pm.vbs
0
 
gamarrojgqCommented:
Ok, lets try the function first,

comment this line

     'objSheet.Range("K2:K" & lastrow).value = SortText(objSheet.Range("K2:K" & lastrow).value)

And add this one just below

           Msgbox SortText("Z;L;B;I;A;J")

If you get the Message with the Values Sorted, then the function is allright and we have to see what value is receiving when call it with the first line
0
 
GessWurkerAuthor Commented:
OK. I did what you suggested and now I get:

Line:  14
Char:  5
Error:  Type mismatch
0
 
GessWurkerAuthor Commented:
Note: I get the same error if I take CStr out of line 14.
0
 
gamarrojgqCommented:
Ok, I think I got it, change this line

Dim vecBase()

For this one

Dim vecBase
0
 
GessWurkerAuthor Commented:
Yes! Getting closer! Now the msg box shows the items sorted properly.

However, if I uncomment the line I REALLY want to sort, I get CStr type mismatch:

objSheet.Range("K2:K" & lastrow).value = SortText(objSheet.Range("K2:K" & lastrow).value)
0
 
gamarrojgqCommented:
Ok, but are you sure that objSheet.Range("K2:K" & lastrow).value is returning a value?

Add this line

Msgbox (objSheet.Range("K2:K" & lastrow).value)

Before this one

objSheet.Range("K2:K" & lastrow).value = SortText(objSheet.Range("K2:K" & lastrow).value)
0
 
GessWurkerAuthor Commented:
Msgbox (objSheet.Range("K2:K" & lastrow).value) returns a type mismatch error

Msgbox (objSheet.Range("K2").value) does not return an error, but it only returns the first entry in the cell before the semi-colon.

We need process all entries in all cells K2 throught K last row. hmmm...

0
 
gamarrojgqCommented:
Ok try it like this

    Dim objRange
    Dim intRow
    Dim strColValue
    Set objRange = ActiveSheet.Range("K2")
   
    For intRow = 1 To (lastrow - 1)
      strColValue = SortText(objRange(intRow, 1).Value)
        objRange(intRow, 1).Value = SortText(strColValue)
    Next
0
 
gamarrojgqCommented:
Also, add this to the SortText Function,

    If Len(Trim("" & strBase)) = 0 Then
        SortText = ""
        Exit Function
    End If

just before the Dim strSorted Line
0
 
GessWurkerAuthor Commented:
Can you post the complete code the way you're suggesting I try it? I've (re)attached the code I'm working with. 031611pm.vbs
0
 
gamarrojgqCommented:
Ok, here it is 031611pmMOD.vbs
0
 
GessWurkerAuthor Commented:
gamarrojqq: It works! It works! Thanks so much.

There is only one thing which concerns me, but it's not a show-stopper. We are left with a leading semi-colon in the addl_auths cells where sorting has occurred. Is there any way to prevent that leading semi-colon?  Here's an example of sorted content:

;Aquino (D);Belatti (D);Chang (D);Ching (R);Chong (D);Cullen (D);Herkes (D);Johanson (R);Keith-Agaran (D);McKelvey (D);Mizuno (D);Nishimoto (D);Pine (R);Rhoads (D);Riviere (R);Souki (D);Tokioka (D);Ward (R);

Again, if it's possible to prevent the leading semi-colon, that would be great. But either way, the script works great!
0
 
gamarrojgqCommented:
ok, great, my guess is that there is a blank space in the cell value so it will put it at first, so, you can avoid that changing this line

strSorted = strSorted & listad("TextValue") & ";"

For these

        If Len(Trim(listad("TextValue"))) > 0 Then
            strSorted = strSorted & listad("TextValue") & ";"
        End If
0
 
GessWurkerAuthor Commented:
Last: Next I want to reverse-sort the Status field by date. Currently, Oldest entries are listed first (by date). I want to list newest entries first, followed by older entries. If it's possible to do re-sort Status entries, please let me know and I'll post a new (related) question.
0
 
gamarrojgqCommented:
Yes, I think it is possible, and yes you have to post a new question ;)

Did the change I send you works?
0
 
GessWurkerAuthor Commented:
The change isn't working for me yet. Maybe I put it in the wrong place? See attached code. 031711pm.vbs
0
 
gamarrojgqCommented:
Yes, it was in the wrong place, here it is modified
031711pmMOD.vbs
0
 
GessWurkerAuthor Commented:
Still not quite. I just ran your version on a larger file. Here are the addl_auths contents:

;Monning (D);

;Rhoads (D);

;Aquino (D);Belatti (D);Chang (D);Ching (R);Chong (D);Cullen (D);Herkes (D);Johanson (R);Keith-Agaran (D);McKelvey (D);Mizuno (D);Nishimoto (D);Pine (R);Rhoads (D);Riviere (R);Souki (D);Tokioka (D);Ward (R);

;Baker (D);Kidani (D);Ryan (D);

;English (D);Galuteria (D);Green (D);Tokuda (D);
0
 
gamarrojgqCommented:
weird, ok try this one
031711pmVER3.vbs
0
 
GessWurkerAuthor Commented:
The $ sign at line 44 causes  Error: Invalid character.
0
 
gamarrojgqCommented:
ok, just remove the $ sign
0
 
GessWurkerAuthor Commented:
Removed the $sign and ran the script. Alas... we still have the leading semi-colon; no change. Shall we just leave it alone and move on?
0
 
gamarrojgqCommented:
ok, just for fun, try this one, and let me know the addl_auths contents
031711pmFINAL.vbs
0
 
GessWurkerAuthor Commented:
Hmmm... interesting, now the author field has leading [[, example:

[[Oshiro M (D);

But the addl_auth contents still have leading semi-colons, example:

;Rhoads (D);
0
 
GessWurkerAuthor Commented:
Yes... I had to switch it to column L. That's the REAL column now. Sorry if I switched things up on you at some point. (Oops... we started receiving a new column during this post, I think!) I'll try the latest FINAL version. ;-)
0
 
GessWurkerAuthor Commented:
Glory be! WE HAVE A WINNER!!!
0
 
GessWurkerAuthor Commented:
I just asked a related question. Cheers!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.