Wrox Home  
Search P2P Archive for: Go

  Return to Index  

pro_vb thread: How to sort by multiple sections of a string array?


Message #1 by "Richard D Roberts" <RichardDRoberts@h...> on Fri, 14 Sep 2001 17:12:51
Thanks for all your help I used a combination of the dictionary object and 
ADO recordset...Here is a portion of the code that I used:

Option Explicit
    '===========================================================
    '= Sort Object variables                                 
    '===========================================================
    Private rsSorting               As ADOR.Recordset
    Private oDict                   As Dictionary
    Private mDirty                  As Boolean
    Private SortCardKey_p()         As String
    Private VirtualListbox()        As String
    '===========================================================    
    '= Object Contants                                            
    '===========================================================
    Private Const COMMA             As String = ","
    Private Const CARET             As String = "^"
    Private Const FIELD_NAME        As String = "Field"
Public Property Let SortCardKey(ByVal sSortCardKey As String)
    SortCardKey_p = Split(sSortCardKey, COMMA)
End Property
Public Sub AddItemKey(ByVal sItem As String, ByVal Delimiter As String)
    On Error Resume Next
    If UBound(SortCardKey_p) < 0 Then Err.Clear: Err.Raise 445: Exit Sub
    Dim vKey As Variant
    vKey = BuildSortKey(sItem, Delimiter)
    oDict.Add vKey, sItem
    If Err.Number = 0 Then
        mDirty = True
        Call AddItem(sItem)
    End If
    
End Sub
Private Function BuildSortKey(ByVal sItem As String, ByVal Delimiter As 
String) As Variant
    Dim strWork() As String
    Dim vBuffer As Variant
    Dim i As Integer
    
    strWork = Split(sItem, Delimiter)
    For i = 0 To UBound(SortCardKey_p)
        vBuffer = vBuffer & strWork(CInt(SortCardKey_p(i)) - 1)
    Next
    
    BuildSortKey = vBuffer
    
End Function
Public Sub AddItem(ByVal sItem As String, Optional ByVal lIndex As Long = 
0)
    On Error GoTo OtherError
    Dim i As Long
    mDirty = True
    If lIndex > UBound(VirtualListbox) Then GoTo ErrorHandle
    'Tell user the amount exceeds the size of the array.
    'ie.(subscript error)
    
    ReDim Preserve VirtualListbox(UBound(VirtualListbox) + 1)
    'Resize the array and don't clear the items in the array
    'that don't get removed from resizeing it.
    'If preserve wasn't here then the array would resize
    'null items.
    
    If lIndex = 0 Then
        VirtualListbox(UBound(VirtualListbox)) = sItem
        'If index is 0 then just add the item to the bottom
        'of the array like the vb listbox does by default.
    Else
        For i = UBound(VirtualListbox) To lIndex Step -1
            VirtualListbox(i) = VirtualListbox(i - 1)
            'If an index to place the item at is specified, then
            'put all the items in the next index after theirs,
            'example: index0 would goto index1, index1 goes
            'to index2, etc..
        Next i
        VirtualListbox(lIndex) = sItem
        'After moving all the indexes around,
        'add this item to the specified index
        'within the array.
    End If
    Exit Sub
ErrorHandle:
    Err.Raise 1100 + vbObjectError, "VirtualListBox.AddItem", _
    "Your attempting to Add an item " _
    & "in a place that doesn't exist!" & vbCrLf _
    & "This is what causes subscript errors, an " _
    & "array can't exceed its limit."
    Exit Sub
OtherError:
    Err.Raise 1110 + vbObjectError, "VirtualListBox.AddItem", 
Err.Description
     
End Sub
Public Sub Sort(ByVal SortCard As String, ByVal Delimiter As String)
    On Error GoTo OtherError
    If Not mDirty Then Err.Raise 445
    
    Dim i               As Integer
    Dim j               As Integer
    Dim sFieldName      As String
    Dim sIndexString    As String
    Dim sBuffer         As String
    Dim sWork()         As String
    Dim sSortCard()     As String
    Dim sSortOrder()    As String
    Dim vValues()       As Variant
    Dim vFieldList()    As Variant


    sWork = Split(VirtualListbox(1), Delimiter)

    ReDim vFieldList(UBound(sWork))

    Set rsSorting = New ADOR.Recordset

    '= Build Fields
    For i = 0 To UBound(sWork)
        sFieldName = FIELD_NAME & (i + 1)
        vFieldList(i) = sFieldName
        rsSorting.Fields.Append sFieldName, adVarChar, 200
    Next

    sSortCard = Split(SortCard, COMMA)

    rsSorting.Open
    '= Build Indexes from Sort Card
    For i = 0 To UBound(sSortCard)
        sSortOrder = Split(sSortCard(i), CARET)
        sFieldName = FIELD_NAME & sSortOrder(0)
        rsSorting.Fields(sFieldName).Properties("OPTIMIZE") = True
        If Len(sIndexString) <> 0 Then sIndexString = sIndexString & COMMA
        sIndexString = sIndexString & sFieldName & CSortOrder(sSortOrder
(1))
    Next

    '= Build Data array and Add to Recordset
    For i = 1 To UBound(VirtualListbox)
        sWork = Split(VirtualListbox(i), Delimiter)
        ReDim vValues(UBound(sWork))
        For j = 0 To UBound(sWork)
            vValues(j) = sWork(j)
        Next
        rsSorting.AddNew vFieldList, vValues
    Next
    
    '= Sort Recordset
    rsSorting.Sort = sIndexString
    
    '= Reload VirtualListBox with Sorted Data
    ReDim VirtualListbox(0) As String
    sBuffer = rsSorting.GetString(, , Delimiter, vbCr)
    sWork = Split(sBuffer, vbCr)

    For i = 0 To UBound(sWork)
        If Len(sWork(i)) <> 0 Then
            Call AddItem(sWork(i))
        End If
    Next
    Exit Sub
OtherError:
    Err.Raise Err.Number, "VirtualListBox.Sort", Err.Description
End Sub
Private Function CSortOrder(ByVal sSortOrder As String) As String
    
    If Trim(sSortOrder) = "D" Then
        CSortOrder = " DESC"
    Else
        CSortOrder = " ASC"
    End If

End Function


> That's a good idea as well :)
> 
> Cardyin
> 
> ---------------------------------------
> Cardyin Kim
> Client/Server & Web Development Analyst
> Information Services
> San Antonio Community Hospital
> ckim@s...     (xxx)xxx-xxxx     
> ---------------------------------------
> 
> 
> -----Original Message-----
> From: John Stendor [mailto:john.stendor@c...]
> Sent: Friday, September 14, 2001 12:50 PM
> To: professional vb
> Subject: [pro_vb] Re: How to sort by multiple sections of a string arr
> ay?
> 
> 
> How about using a Dictionary Object !!!
> 
> Kim, Cardyin wrote:
> > 
> > You can use a disconnected recordset so that you don't have
> > any data connection anywhere.  If you use this method, all
> > your data would remain in memory, but you would also have
> > access to the sorting and filtering power of a database
> > at your disposal.
> > 
> > Cardyin
> > 
> > ---------------------------------------
> > Cardyin Kim
> > Client/Server & Web Development Analyst
> > Information Services
> > San Antonio Community Hospital
> > ckim@s...     (xxx)xxx-xxxx 
> > ---------------------------------------
> > 
> > -----Original Message-----
> > From: Richard D Roberts [mailto:RichardDRoberts@h...]
> > Sent: Friday, September 14, 2001 11:07 AM
> > To: professional vb
> > Subject: [pro_vb] Re: How to sort by multiple sections of a string
> > array?
> > 
> > NOTE: I need to keep this in memory so I don't hit any databases...I 
want
> > to keep this fast as possible  Thank you
> > 
> > > I have a string array that i want to sort and I want to pass in sort
> > > criteria see ex below:
> > >
> > > I want to sort the following string...it is in my sArray() as string
> > > Field1: BASIC=        Field5:Joe      Field9:  MA
> > > Field2: 12345 Field6:20010920 Field10: Y
> > > Field3: AI    Field7:$100.00  Field11: N
> > > Field4: Smith Field8: 0054321 Field12: Maybe
> > > "BASIC=12345|AI|Smith|Joe|20010920|$100.00|0054321|MA|Y|N|Maybe"
> > > "BASIC=12346|AU|Jones|Paul|20010920|$200.00|0034521|AR|N|N|Couldbe"
> > 
> "BASIC=13846|PI|Miller|Paula|20010920|$500.00|0025432|AL|N|N|Shouldbe"
> > > "BASIC=14526|AU|Zane|Roland|20010920|$125.00|0012345|CA|N|N|Wouldbe"
> > > "BASIC=12345|AI|Smith|Joe|20010920|$700.00|MA|0054321|Y|N|Maybe"
> > >
> > > I want to sort in the following fields - this would not Delete
> duplicates
> > > Sort=Field8,CH,A,Field3,CH,A,Field9,CH,A
> > >
> > > I also want to delete duplicate records based on this Sort critiera
> > > Merge=Field8,CH,A,Field3,CH,A,Field9,CH,A   <<This would Sort and 
delete
> > > Duplicates
> > >
> > > Any ideas or examples on how I should do this?
> > >
> > > Thanks!
> > > Richard
> 

  Return to Index