Deko,
Here's an array library I wrote back day.
Option Compare Database
Option Explicit
Public Const VB_Binary = 0
Public Const VB_Text = 1
Public Function ArrayJoin(InArr ay() As String, Optional ByVal Sep As
String = " ") As String
' Build a string of words from "InArray" using "Sep" to separate each
word.
Dim i As Integer ' array index
For i = LBound(InArray) To UBound(InArray) ' loop through array
WordB and build string
If i = UBound(InArray) Then ' if last word in input
array
ArrayJoin = ArrayJoin & InArray(i) ' add word to output
string withOUT separator
Else ' if NOT last word in
input array
ArrayJoin = ArrayJoin & InArray(i) & Sep ' add word to output
string with separator
End If ' if last word in input
array
Next
End Function
Public Sub ArraySplit(Text As String, InArray() As String, Optional
ByVal Sep As String = " ", Optional ByVal Compare As Long = VB_Binary)
' Fill the "InArray" array with words from "Text", using "Sep" as a
separator for each word.
Dim WordB As Integer ' current word's
starting string position
Dim WordE As Integer ' current word's ending
string position
Dim i As Integer ' word array's current
element index
If Len(Text) = 0 Then Exit Sub ' if no text to split
i = 0 ' initialize word
array's current element index
WordB = 1 ' initialize current
word's starting string position
ReDim InArray(0) ' initialize word array
WordE = InStr(1, Text, Sep, Compare) ' search for first
separator
While WordE > 0 ' loop each word in text
string
InArray(i) = Mid$(Text, WordB, WordE - WordB) ' load word into array
i = i + 1 ' bump word array's
current element index
ReDim Preserve InArray(i) ' expand word array
WordB = WordE + Len(Sep) ' set start of next word
WordE = InStr(WordB, Text, Sep, Compare) ' search for next
separator
Wend ' next word
If WordB <= Len(Text) Then ' if text does NOT end
with separator
InArray(i) = Mid$(Text, WordB) ' load last word into
array
Else ' if text ends with
separator
ReDim Preserve InArray(i - 1) ' compress word array
End If ' if text does NOT end
with separator
End Sub
Public Function ArraySearch(InA rray() As String, Word As String) As
Integer
' Search SORTED "InArray" for "Word", return array number (of first
occurrence) if found or
' -1 if not.
Dim Low As Integer ' low search boundary
Dim Bin As Integer ' binary split search
boundary
Dim High As Integer ' high boundary
ArraySearch = -1 ' return word NOT found
Low = LBound(InArray) ' set low search
boundary
If Word < InArray(Low) Then Exit Function ' if word too low to be
in array, return 0
High = UBound(InArray) ' set high search
boundary
If Word > InArray(High) Then Exit Function ' if word too high to be
in array, return 0
If Word = InArray(Low) Then ' if low match
ArraySearch = Low ' return array number of
FIRST word found
Exit Function ' return to caller
End If ' if low match
If Word = InArray(High) Then ' if high match
ArraySearch = High ' return array number of
FIRST word found
Exit Function ' return to caller
End If ' if high match
Do Until High - Low = 1 ' loop through array
Bin = ((High - Low) \ 2) + Low ' binary split array
If Word = InArray(Bin) Then ' if match
ArraySearch = Bin ' return array number of
FIRST word found
Exit Function ' return to caller
End If ' if match
If Word > InArray(Bin) Then ' if word higher then
binary split
Low = Bin ' reset low boundary for
next binary split
Else ' if word lowwer then
binary split
High = Bin ' reset high boundary
for next binary split
End If ' if word higher then
binary split
Loop ' next search
End Function
Public Sub ArraySort(InArr ay() As String)
Dim i As Integer ' array index
Dim First As Integer ' first array number
Dim Last As Integer ' last array number
Dim Split As Integer ' array binary-split
pointer
Dim Swap As String ' array element temporay
swap
First = LBound(InArray) ' get first array number
Last = UBound(InArray) ' get last array number
Split = (Last - First + 1) \ 2 ' calculate binary split
array pointer
Do While Split > 0 ' sort loop
For i = First To Last - Split ' sort low half loop
If InArray(i) > InArray(Split + i) Then ' if value in low half
greater then value in high half
Swap = InArray(Split + i) ' save high half
(lesser) value
InArray(Split + i) = InArray(i) ' move low half
(greater) value to high half
InArray(i) = Swap ' move saved (lesser)
high half value to low half
End If ' if value in low half
greater then value in high half
Next i ' next lower half sort
For i = Last - Split To First Step -1 ' sort high half loop
If InArray(i) > InArray(Split + i) Then ' if value in low half
greater then value in high half
Swap = InArray(Split + i) ' save high half
(lesser) value
InArray(Split + i) = InArray(i) ' move low half
(greater) value to high half
InArray(i) = Swap ' move saved (lesser)
high half value to low half
End If ' if value in low half
greater then value in high half
Next i ' next lower half sort
Split = Split \ 2 ' re-calculate binary
split array pointer for next loop
Loop
End Sub
Public Function ArrayScan(InArr ay() As String, Word As String) As
Integer
' Scan UNSORTED "InArray" for "Word", return array number (of first
occurrence) if found or
' -1 if not.
Dim i As Integer ' array index
For i = LBound(InArray) To LBound(InArray) ' scan through array
If InArray(i) = Word Then ' if word found
ArrayScan = i ' return array number of
FIRST word found
Exit Function ' return to caller
End If ' if value in low half
greater then value in high half
Next i ' next lower half sort
ArrayScan = -1 ' return word NOT found
End Function
On Wed, 02 Mar 2005 18:08:53 GMT, "deko" <de**@hotmail.c om> wrote:
Yuo forgot to use the Preserve keyword in the ReDim statement. Without
Presserve, the array gets erased every time it is ReDim'd.
I see. Now this works properly:
Public Function test()
Dim i As Integer
Dim j As Integer
Dim s As String
Dim astr() As String
Do While i < 10
If i > 5 Then
ReDim Preserve astr(1 To i)
s = "string" & i
astr(i) = s
End If
i = i + 1
Loop
For j = LBound(astr) To UBound(astr)
Debug.Print astr(j)
Next
End Function
Thanks!
