OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 19-12-2007, 14:51
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
Join Date: Mar 2005
Posts: 836
Default [useful code] sortDelimitedText

Here's a function that sorts any amount of delimited text (the limit is only the RAM :-) very very quickly

Usage: sortedString = sortDelimitedText( someString, vbCrLf, bKeepDupes:=False, bAscending:=False, bCaseSensitive:=True)

All parameters except the text to sort are optional, their defaults are specified in the function header and are visible in the code-autocomplete tooltips (invokable also by Ctrl-I)
Function sortDelimitedText _
               (text$, _
                Optional Delim$ = vbCr, _
                Optional ByVal bKeepDupes As Boolean = False, _
                Optional ByVal bAscending As Boolean = True, _
                Optional ByVal bCaseSensitive As Boolean = False) _
   As String
   Dim var As Variant, sorted As Collection
   Dim L&, LDelim&, LText&, s$, k$, Direction&, txtCmp&
   Dim a&, b&, C&, rel&, collCnt&
   Set sorted = New Collection
   Direction = IIf(bAscending, 1, -1)
   txtCmp = IIf(bCaseSensitive, vbBinaryCompare, vbTextCompare)
   LDelim = Len(Delim)
   On Error Resume Next 'ignore collection VB error on adding a dupe
   For Each var In Split(text, Delim)
      s = CStr(var)
      If bKeepDupes Then
         k = (collCnt + 1)
         k = s
      End If
      a = 1: b = collCnt: C = 0: rel = 0
      Do While b - a >= 0
         C = (a + b) \ 2: rel = StrComp(s, sorted(C), txtCmp) * Direction
         Select Case rel
            Case -1: If C = a Then Exit Do Else b = C
            Case 0:  Exit Do
            Case 1:  If b = a Then Exit Do Else If a = C Then a = b Else a = C
         End Select
      If C = 0 Then sorted.Add s, k Else If rel = -1 Then sorted.Add s, k, C Else sorted.Add s, k, , C
      If bKeepDupes Then
         collCnt = collCnt + 1
      ElseIf Err.Number = 0 Then
         LText = LText + Len(s) + LDelim
         collCnt = collCnt + 1
      End If
   If bKeepDupes Then LText = Len(text)
   If LText = 0 Then Exit Function
   sortDelimitedText = Space$(LText)
   L = 1
   For Each var In sorted
     Mid$(sortDelimitedText, L) = var: L = L + Len(var)
     If L >= LText Then Exit For 'last delim is unneeded
     Mid$(sortDelimitedText, L) = Delim: L = L + LDelim
End Function
Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

All times are GMT -5. The time now is 06:55.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com