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
>