Here is what I have so far as a class.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "StringArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'========================================================================================
'String Array Class Module
'----------------------------------------------------------------------------------------
'Desc: Provides a wrapper for an 1D array of strings to make it easier
to add and remove
' items and sort.
'Auth: Bryan Loeper
'Date: 05-01-2007
'========================================================================================
'METHODS
'----------------------------------------------------------------------------------------
'Sort()
' Sorts the array, case sensitive.
'
'AddItem(Item As String) As Boolean
' Adds Item to the array and dynamically resizes.
' Returns TRUE if successful, FALSE otherwise.
'
'RemoveItem(Item As String) As Boolean
' Removes Item from the array and dynamically resizes.
' Returns TRUE if successful, FALSE otherwise.
'
'IndexOf(Item As String) As Long
' Returns the index of the first occurence of Item in the array. If
Item does not occur
' in the array, it returns -1.
'
'Item(Index As Long) As String
' Returns the item at a specific index if the index is in bounds.
Otherwise returns
' NULL.
'
'Randomize(Items As Long, Length As Integer)
' Destroys current array and generates random array of size n = Items
and fills it with
' items of size n = Length.
'========================================================================================
'PROPERTIES
'----------------------------------------------------------------------------------------
'Count As Long
' Returns the number of items in the array.
'========================================================================================
Option Explicit
Option Base 1
Private ARR_BASE As Long 'Pseudo-constant assigned during
initialization.
Private p_isSorted As Boolean
Private p_strArray() As String
Public Sub Sort()
If Not p_isSorted Then
Quick_Sort p_strArray, LBound(p_strArray), UBound(p_strArray)
p_isSorted = True
End If
End Sub
Private Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As
Long, ByVal Last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) \ 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
Public Function AddItem(Item As String) As Boolean
Dim UBnd As Long
'Uses built-in size property to get current size to avoid
duplication of code.
UBnd = Count + ARR_BASE
ReDim Preserve p_strArray(UBnd) As String
p_strArray(UBnd) = Item
'Marks list as unsorted and returns true if Item can be found in
the list.
If IndexOf(Item) <> -1 Then p_isSorted = False: AddItem = True
End Function
Public Property Get Count() As Long
If (Not p_strArray) = -1 Then
Count = 0
Else
'Count = Max - Min + 1
Count = (UBound(p_strArray) - LBound(p_strArray)) + 1
End If
End Property
Public Function RemoveItem(Item As String) As Boolean
Dim loc As Long
loc = IndexOf(Item)
If loc <> -1 Then
If Count > 1 Then
Dim i As Long
For i = loc To UBound(p_strArray) - 1
p_strArray(i) = p_strArray(i + 1)
Next i
ReDim Preserve p_strArray(i - 1) As String
RemoveItem = True
Else
Dim x() As String
p_strArray = x
RemoveItem = True
End If
End If
End Function
Public Function IndexOf(Item As String) As Long
'Default NOT_FOUND
IndexOf = -1
If Count > 0 Then
If In_Array(Item) Then
Dim i As Integer
For i = LBound(p_strArray) To UBound(p_strArray)
If p_strArray(i) = Item Then
IndexOf = i
Exit Function
End If
Next i
End If
End If
End Function
Public Property Get Item(Index As Long) As Variant
If Index < (Count + ARR_BASE) Then
Item = p_strArray(Index)
Else
Item = Null
End If
End Property
Private Sub Class_Initialize()
Dim x(3) As String
ARR_BASE = LBound(x)
End Sub
Private Function In_Array(Item As String) As Boolean
If Count > 0 Then
Dim x() As String
x = p_strArray
If Not p_isSorted Then
Quick_Sort x, LBound(x), UBound(x)
End If
In_Array = Binary_Search(x, Item)
End If
End Function
Private Function Binary_Search(ByRef Haystack() As String, ByVal
Needle As String) As Boolean
Dim l As Long, m As Long, u As Long
l = LBound(Haystack)
u = UBound(Haystack)
Do While l < u
m = (l + u) \ 2
If Needle > Haystack(m) Then
l = m + 1
Else
u = m
End If
Loop
If Haystack(l) = Needle Then
Binary_Search = True
Else
Binary_Search = False
End If
End Function
Public Sub RandomizeArray(Items As Long, Length As Long)
ReDim p_strArray(1 To Items) As String
Dim i As Long
Dim j As Byte
Dim rString As String
For i = 1 To Items
rString = ""
For j = 1 To Length
Randomize
rString = rString & Chr(Int((26 * Rnd) + 65))
Next j
p_strArray(i) = rString
Next i
End Sub
