Array Properties in a Class
 

I searched as best I could, but couldn't find anything on the
subject. Hopefully someone out there has an answer or knows where one
is.

I'm writing a wrapper for arrays of strings to make my life down the
road easier (working on a large-ish scale data analysis project with a
_lot_ of string comparison, sorting, adding, and removing). Right
now, the following works:

Public Sub Test()
Dim sArray As New StringArray
sArray.AddItem("A")
sArray.AddItem("B")
sArray.AddItem("C")
For i = 1 to sArray.Count
Debug.Print sArray.Item(i)
Next i
End Sub


I'd like to be able to use sArray(i) instead of sArray.Item(i), but
can't find anything on it. I tried using the NewEnum hack for
Collection wrappers, but VBA doesn't seem to agree with me that it
should work about the same. Any suggestions?

(In case it helps, StringArray contains a Private p_strArray() As
String)

Array Properties in a Class
 

Maybe I'm going to step in it here, but it seems to me that StringArray
isn't a native VBA class. You can define a default property of a custom
class, if you have NotePad. See this page on Chip Pearson's web site:

http://cpearson.com/excel/DefaultProperty.htm

You would make Item the default property.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


wrote in message
ups.com...
I searched as best I could, but couldn't find anything on the
subject. Hopefully someone out there has an answer or knows where one
is.

I'm writing a wrapper for arrays of strings to make my life down the
road easier (working on a large-ish scale data analysis project with a
_lot_ of string comparison, sorting, adding, and removing). Right
now, the following works:

Public Sub Test()
Dim sArray As New StringArray
sArray.AddItem("A")
sArray.AddItem("B")
sArray.AddItem("C")
For i = 1 to sArray.Count
Debug.Print sArray.Item(i)
Next i
End Sub


I'd like to be able to use sArray(i) instead of sArray.Item(i), but
can't find anything on it. I tried using the NewEnum hack for
Collection wrappers, but VBA doesn't seem to agree with me that it
should work about the same. Any suggestions?

(In case it helps, StringArray contains a Private p_strArray() As
String)

Array Properties in a Class
 

That's exactly what I'm looking for, thanks!

On May 1, 9:12 pm, "Jon Peltier"
wrote:
Maybe I'm going to step in it here, but it seems to me that StringArray
isn't a native VBA class. You can define a default property of a custom
class, if you have NotePad. See this page on Chip Pearson's web site:

http://cpearson.com/excel/DefaultProperty.htm

You would make Item the default property.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutionshttp://PeltierTech.com
_______

Array Properties in a Class
 

As it turns out, that didn't do quite what I thought it would. For
clarification:

I have a udt StringArray. I need an instance of StringArray (ie sArr)
to allow both (i) and .Item(i)

sArr.Item(i) works just fine.
sArr(i) throws an error.

-Bryan

On May 2, 6:32 am, wrote:
That's exactly what I'm looking for, thanks!

On May 1, 9:12 pm, "Jon Peltier"
wrote:



Maybe I'm going to step in it here, but it seems to me that StringArray
isn't a native VBA class. You can define a default property of a custom
class, if you have NotePad. See this page on Chip Pearson's web site:

http://cpearson.com/excel/DefaultProperty.htm

You would make Item the default property.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutionshttp://PeltierTech.com
_______- Hide quoted text -

- Show quoted text -

Array Properties in a Class
 

What's the definition of your udt? Can you convert the udt to a class?
Chip's technique works for classes, not udts.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


wrote in message
oups.com...
As it turns out, that didn't do quite what I thought it would. For
clarification:

I have a udt StringArray. I need an instance of StringArray (ie sArr)
to allow both (i) and .Item(i)

sArr.Item(i) works just fine.
sArr(i) throws an error.

-Bryan

On May 2, 6:32 am, wrote:
That's exactly what I'm looking for, thanks!

On May 1, 9:12 pm, "Jon Peltier"
wrote:



Maybe I'm going to step in it here, but it seems to me that StringArray
isn't a native VBA class. You can define a default property of a custom
class, if you have NotePad. See this page on Chip Pearson's web site:

http://cpearson.com/excel/DefaultProperty.htm

You would make Item the default property.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutionshttp://PeltierTech.com
_______- Hide quoted text -

- Show quoted text -

Array Properties in a Class
 

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

Array Properties in a Class
 

A lot to think about. According to Chip, you should export the module, open
it in NotePad, and after this line:

Public Property Get Item(Index As Long) As Variant

you need to insert this:

Attribute Item.VB_UserMemId = 0

Then save and reimport the module into your project.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


wrote in message
ups.com...
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

Array Properties in a Class
 

That works perfectly, thanks! I could have sworn that's what I'd done
earlier, but I guess not.

On May 2, 11:34 am, "Jon Peltier"
wrote:
A lot to think about. According to Chip, you should export the module, open
it in NotePad, and after this line:

Public Property Get Item(Index As Long) As Variant

you need to insert this:

Attribute Item.VB_UserMemId = 0

Then save and reimport the module into your project.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutionshttp://PeltierTech.com
_______

wrote in message

ups.com...



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- Hide quoted text -

- Show quoted text -