Solved

Adjust vba excel script to sort entries in a column

Posted on 2011-03-16
42
406 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:GessWurker
  • 22
  • 20
42 Comments
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35149292
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
 

Author Comment

by:GessWurker
ID: 35149934
Hmm.. I'm not sure how to add the reference to Microsoft Active Data Objects.
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150042
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
 

Author Comment

by:GessWurker
ID: 35150229
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
 

Author Comment

by:GessWurker
ID: 35150249
Note: There's a supporting file also. I've attached it. StateList.txt
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150310
Ok, then use this version of the function
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150313
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
 

Author Comment

by:GessWurker
ID: 35150428
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150497
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
 

Author Comment

by:GessWurker
ID: 35150635
Getting closer. Now we can call the function but it fails on this line:

vecBase = Split(strBase, ";")

The error:

Type mismatch: 'strBase'
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150695
ok try to change that line for this one

vecBase = Split(CStr(strBase), ";")
0
 

Author Comment

by:GessWurker
ID: 35150723
Yes, I thought that might work too, but when I tried it:

Type mismatch: 'Cstr'
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150748
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
 

Author Comment

by:GessWurker
ID: 35150820
See attached script. Line 132 is where I'm trying to call your function. 031611pm.vbs
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35150906
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
 

Author Comment

by:GessWurker
ID: 35151182
OK. I did what you suggested and now I get:

Line:  14
Char:  5
Error:  Type mismatch
0
 

Author Comment

by:GessWurker
ID: 35151243
Note: I get the same error if I take CStr out of line 14.
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35151711
Ok, I think I got it, change this line

Dim vecBase()

For this one

Dim vecBase
0
 

Author Comment

by:GessWurker
ID: 35151802
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35151831
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
 

Author Comment

by:GessWurker
ID: 35152240
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35152398
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35152416
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
 

Author Comment

by:GessWurker
ID: 35152480
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35152515
Ok, here it is 031611pmMOD.vbs
0
 

Author Comment

by:GessWurker
ID: 35158172
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35158240
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
 

Author Comment

by:GessWurker
ID: 35158259
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35158415
Yes, I think it is possible, and yes you have to post a new question ;)

Did the change I send you works?
0
 

Author Comment

by:GessWurker
ID: 35158491
The change isn't working for me yet. Maybe I put it in the wrong place? See attached code. 031711pm.vbs
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35158516
Yes, it was in the wrong place, here it is modified
031711pmMOD.vbs
0
 

Author Comment

by:GessWurker
ID: 35158643
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35158746
weird, ok try this one
031711pmVER3.vbs
0
 

Author Comment

by:GessWurker
ID: 35158990
The $ sign at line 44 causes  Error: Invalid character.
0
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35159020
ok, just remove the $ sign
0
 

Author Comment

by:GessWurker
ID: 35159054
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
 
LVL 13

Expert Comment

by:gamarrojgq
ID: 35159156
ok, just for fun, try this one, and let me know the addl_auths contents
031711pmFINAL.vbs
0
 

Author Comment

by:GessWurker
ID: 35159193
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
 
LVL 13

Accepted Solution

by:
gamarrojgq earned 500 total points
ID: 35159307
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
 

Author Comment

by:GessWurker
ID: 35159423
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
 

Author Comment

by:GessWurker
ID: 35159625
Glory be! WE HAVE A WINNER!!!
0
 

Author Comment

by:GessWurker
ID: 35159710
I just asked a related question. Cheers!
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now