Tips & Tricks
Along with a couple of general interest topics, I've duplicated most of the functionality of some of the newer string introduced in Visual Basic version 6.0 using syntax compatible with earlier versions of Visual Basic. Even if you have version 6.0, you still might learn a few tricks by examining the code.
In many of the routines provided, there could be more error checking, particularly with optional parameters. For example, there are no checks to make sure that optional parameters contain values of the expected type. Since optional parameters are passed as Variants (required for optional fields in version 5.0), it's possible that an optional parameter which expects an integer value could be assigned a string value or even an object reference. I'll leave additional error checking as an exercise for the reader.
Comparing strings containing numeric values
I've seen situations where numeric values had to be sorted; however, the numbers also had to be stored as strings. Such an occasion arises when you want to take advantage of the list box's sorted property to automatically sort numeric values. However, the list box only accepts string values.
Simply converting the numbers to strings using CStr$ (or letting Visual Basic perform automatic numeric to string conversions) will not produce the desired results. Consider the following:
Dim i As Integer
'Set the list box's sorted property to True at design-time.
List1.Clear
For i = 1 To 10
List1.AddItem CStr$(i)
Next
Although, at first glance, it appears that this might yield the desired result, the above code produces the following list:
1
10
2
3
4
5
6
7
8
9
The problem is that the string "10" sorts before the string "2". To fix this, we need to right align all the numbers within the strings.
There are two approaches we could use to right align all the strings. The first is by using a user-defined pattern with the Format$ function. The second is to use the RSet command.
Dim i As Integer
Dim s As String
List1.Clear
List2.Clear
s = Space$(2) 'Create a string to use with RSet
For i = 1 To 10
'Method #1
List1.AddItem Format$(i, "00")
'Method #2
RSet s = i 'VB automatically converts i into a string
List2.AddItem s
Next
This results in the two lists:
| List1 |
List2 |
| 01 |
_1 |
| 02 |
_2 |
| 03 |
_3 |
| 04 |
_4 |
| 05 |
_5 |
| 06 |
_6 |
| 07 |
_7 |
| 08 |
_8 |
| 09 |
_9 |
| 10 |
10 |
Underscores (_) represent spaces.
Both methods yield the desired results with only a minor difference in the leading character used for single-digit values.
Be careful that you make your strings long enough to accomodate the largest numbers. Using a format of "000000000000" (12 "0"s) or an initial string build with Space$(12) will suffice in most cases.
As you might have guessed, there are some limitations to these approaches. First, negative numbers are still a major problem. Second, numbers with decimals will work fine when using Format$ (try a format like "000000000000.000000000000"), but RSet is not a practical method in such cases.
Even with these limitations, you can still use a list box to automatically sort all positive numbers with and without decimal places.
Working with very long strings
When dealing with long strings (ones with lengths of at least a thousand characters), you may experience some performance degradation. This is a result of the large memory allocations required when performing certain string functions. Consider the following code that keeps appending 10 characters to a string until the string is 100,000 characters long:
Dim sBuf As String
Dim l As Long
Dim sAppend As String
sAppend = "1234567890"
For l = 1 To 10000
sBuf = sBuf & sAppend
'Display progress after every 10,000 characters.
If l Mod 1000 = 0 Then
Debug.Print l, Len(sBuf)
End If
Next
The first thing that you notice is how much slower the program gets as it progresses. The longer sBuf gets, the more memory is allocated with each concatenation operation, and the slower the program runs. Eventually, the program's execution speed appears to come to a grinding halt.
A faster approach would be to allocate all 100,000 characters up-front and overlay the data inside the string using the Mid$ command. Such an approach eliminates all the concatenation operations.
Let's compare the two methods in a side-by-side test:
Dim sBuf As String
Dim l As Long
Dim sAppend As String
Dim sHold As String
Dim t As Single
t = Timer
sAppend = "1234567890"
For l = 1 To 10000
'Append 10 characters.
sBuf = sBuf & sAppend
Next
Debug.Print "Method #1: "; (Timer - t); "seconds"
'Save the results for later comparison.
sHold = sBuf
t = Timer
'Initialize the full 100,000 character buffer.
sBuf = Space$(100000)
For l = 1 To 100000 Step 10
'Overlay the next 10 characters.
Mid$(sBuf, l) = sAppend
Next
Debug.Print "Method #2: "; (Timer - t); "seconds"
'Insure the two methods have produced identical results.
Debug.Print "The results are identical: "; sHold = sBuf
On the machine that I have (a 400 Mhz processor with 128 Mb of RAM), the time difference can only be described as remarkable. I believe the results speak for themselves:
Method #1: 5.929688 seconds
Method #2: 0 seconds
The results are identical: True
Although these results conclusively show the benefits of using the Mid$ command instead of string concatenation, the above example doesn't necessarily demonstrate a practical application of this method.
Below is a routine that applies this technique in a more practical way:
'------------------------------------------------
'Concatenate - "Concatenates" a string into a
' pre-built buffer.
'
'Parameters:
' sBuffer - Buffer
' lIndex - Index of last character appended
' sAppend - String to append
Public Sub Concatenate(ByRef sBuffer As String, _
ByRef lIndex As Long, _
ByRef sAppend As String)
Const BUFFER_SIZE_INCREMENT as long = 10000
'Check to see if there's any room left
If Len(sBuffer) < (lIndex + Len(sAppend)) Then
'Increase the size of the buffer
sBuffer = sBuffer & Space$(BUFFER_SIZE_INCREMENT)
End If
'Overlay sAppend into the buffer
Mid$(sBuffer, lIndex + 1) = sAppend
'Advance the index
lIndex = lIndex + Len(sAppend)
End Sub
To test this routine, the following code accepts strings from the user (until "EXIT" is entered) and appends them to a buffer:
Dim sBuffer As String
Dim lIndex As Long
Dim sAppend As String
Dim sPrompt As String
Const EXIT_VALUE As String = "EXIT"
Const BUFFER_SIZE As Long = 100000
sBuffer = "" 'The buffer will be expanded the
lIndex = 0 ' first time Concatenate is called.
sPrompt = "Enter string (""" _
& EXIT_VALUE _
& """ to quit)"
Do
sAppend = InputBox(sPrompt)
If sAppend <> EXIT_VALUE Then
Concatenate sBuffer, lIndex, sAppend
End If
Loop Until sAppend = EXIT_VALUE
'Keep only the portion of sBuffer that
'has been used.
sBuffer = Left$(sBuffer, lIndex)
Debug.Print "Buffer = '" & sBuffer & "'"
Debug.Print "Length ="; lIndex
With this routine, you can build very long strings without the speed problems of normal concatenation.
Reversing strings (without StrReverse)
The general approach to reversing a string is to take characters from one end of the original string and appending them to the same end of the resulting string. Although it doesn't really matter from which end you start, I've chosen to start at the left end of the original string and prefix each character to the left end of the result:
'------------------------------------------------
'MyStrReverse - Reverses a string.
'
'Parameters:
' sOriginal - The string to reverse.
'
'Returns:
' Returns the reversed string.
Public Function MyStrReverse(ByVal sOriginal As String) As String
Dim sResult As String 'Holds the resulting string
Dim lIndex As Long 'Index to each character of sOriginal
'Initialize results.
sResult = ""
'Visit each character of the original string.
For lIndex = 1 To Len(sOriginal)
'Prefix each character to the result.
sResult = Mid$(sOriginal, lIndex, 1) & sResult
Next
'Return the reversed string.
MyStrReverse = sResult
End Function
If you've read the topic Working with very long strings earlier in this section (Tips & Tricks), you'll realize that all the string concatenations we're doing to reverse the string could carry a significant performance penalty - especially if the original string were very long. Even on my relatively fast 400 Mhz machine, reversing a 100,000 character string took over 71 seconds.
Let's try it again, only this time using the overlaying technique that was discussed in Working with very long strings:
'------------------------------------------------
'MyStrReverse - Reverses a string.
'
'Parameters:
' sOriginal - The string to reverse.
'
'Returns:
' Returns the reversed string.
Public Function MyStrReverse(ByVal sOriginal As String) As String
Dim sResult As String 'Holds the resulting string
Dim lIndex As Long 'Index to each character of sOriginal
Dim lLength As Long 'Length of sOriginal
'Set the resulting string to the same length as the original
sResult = sOriginal
lLength = Len(sOriginal)
'Visit each character of the original string.
For lIndex = 1 To lLength
'Overlay each character into the result.
Mid$(sResult, lLength - lIndex + 1) = Mid$(sOriginal, lIndex, 1)
Next
'Return the reversed string.
MyStrReverse = sResult
End Function
Reversing the same 100,000 character string now only takes less than 0.25 seconds - much better!
Searching a string in reverse (without InStrRev)
Nearly all the functionality of InStrRev has been duplicated. The only significant difference is the parameter fBinary. In Visual Basic version 6.0, this parameter uses an enumerated type. Since earlier versions wouldn't have the enumerated type, I've chosen to implement it as a boolean value.
'------------------------------------------------
'MyInStrRev - Search a string from the left.
'
'Parameters:
' sSource - String to search.
' sSearch - Substring we're trying to find.
' lStart - The starting index into sSource where the
' search will begin. If not provided, start
' at the far right end of sSource.
' fBinary - True if doing a binary search (case sensitive);
' False if doing a text search (case insensitive).
' If not provided, True will be assumed.
'
'Returns:
' Returns the index of sSource where sSearch was found.
' If sSearch is not found, return 0.
Public Function MyInStrRev(ByVal sSource As String, _
ByVal sSearch As String, _
Optional ByVal lStart = -1, _
Optional ByVal fBinary = True) _
As Long
Dim lIndex As Long 'Index into sSource
Dim lLength As Long 'Length of sSearch
'Initialize the return value.
MyInStrRev = 0
lLength = Len(sSearch)
'Where is the search going to begin?
If lStart = -1 Then
'Start at the right end.
lStart = Len(sSource)
ElseIf lStart <1 Then 'Invalid value. Err.Raise 5 ElseIf lStart> Len(sSource) Then
'Bad starting position, return 0.
Exit Function
End If
'Is sSearch empty?
If lLength = 0 Then
'Return the starting position
MyInStrRev = lStart
Exit Function
End If
'There's no sense in starting at the very last character
'position if sSearch is more than one character long.
lIndex = lStart - lLength + 1
If lIndex <1 Then 'sSearch is longer than the searchable area of sSource. MyInStrRev="0" Exit Function End If
'Search without regard to case?
If Not fBinary Then
'Ignore case by converting both strings to the same case.
sSource = UCase$(sSource)
sSearch = UCase$(sSearch)
End If
'Search until all character positions have been looked at.
Do While lIndex > 0
'Have we found sSearch?
If sSearch = Mid$(sSource, lIndex, lLength) Then
'We found it, let's get outa here!
Exit Do
Else
'We haven't found it yet, check the previous position.
lIndex = lIndex - 1
End If
Loop
'Return the positon.
MyInStrRev = lIndex
End Function
Substring replacement (without Replace)
Nearly all the functionality of Replace has been duplicated. The only significant difference is the parameter fBinary. In Visual Basic version 6.0, this parameter uses an enumerated type. Since earlier versions wouldn't have the enumerated type, I've chosen to implement it as a boolean value.
'------------------------------------------------
'MyReplace - Replace substrings within a string.
'
'Parameters:
' sSource - String to search.
' sSearch - Substring to replace.
' sReplace - Replacement value for sSearch.
' lStart - The starting index into sSource where the
' replacements will begin. If not provided,
' searching all of sSource.
' lCount - The maximum # of replacements allowed. If not
' provided, make all possible replacements.
' fBinary - True if doing a binary search (case sensitive);
' False if doing a text search (case insensitive).
' If not provided, True will be assumed.
'
'Returns:
' Returns sSource with occurrences of sSearch replaced.
Public Function MyReplace(ByVal sSource As String, _
ByVal sSearch As String, _
ByVal sReplace As String, _
Optional ByVal lStart = 1, _
Optional ByVal lCount = -1, _
Optional ByVal fBinary = True) _
As String
Dim lIndex As Long 'Index into sSource of last match
Dim lFound As Long 'Index into sSource of current match
Dim lLength As Long 'Length of sSearch
Dim sString As String 'Copy of sSource used in searching
Dim sReturn As String 'Return value - built-up as the
'replacements are made
'How much of sSource are we going to use?
If lStart < 1 Then
'Invalid value.
Err.Raise 5
ElseIf lStart > Len(sSource) Then
'Not using any of sSource, return "".
MyReplace = ""
Exit Function
Else
sSource = Mid$(sSource, lStart)
End If
'How many replacements are we allowed to make?
If lCount = -1 Then
'We can't make any more replacements
'than there are characters to search.
lCount = Len(sSource)
ElseIf lCount < 1 Then
'Invalid value.
Err.Raise 5
End If
'Is sSearch empty?
lLength = Len(sSearch)
If lLength = 0 Then
'No search value, return the unaltered source.
MyReplace = sSource
Exit Function
End If
'Search with regard to case?
If fBinary Then
'Case is important, leave it along.
sString = sSource
Else
'Ignore case by converting both strings to the same case.
sString = UCase$(sSource)
sSearch = UCase$(sSearch)
End If
'Loop initialization.
sReturn = ""
lIndex = 1
'During the loop, the following scenario exists:
'
' sReturn = RRRRR
' sSearch = SSSSS
' sReplace = XXXXX
' sSource = AAAAABBBBBSSSSSCCCCC
' | |
' lIndex lFound
'
'Each of the groups of letters represents the following:
' "A"s = Previously searched area.
' "B"s = The area between the last and the current match.
' "C"s = The area after the current match.
' "R"s = The return value. This is the "A" area with all
' appropriate replacements applied.
' "S"s = The current match.
' "X"s = The replacement value for "S".
'It's important to note that any of the groups, except the
'"S"s & "X"s might be equal to "".
'Keep searching until we're not allowed to make further
'replacements or there are no replacements left to make.
Do
lFound = InStr(lIndex, sString, sSearch)
'Is there a match?
If lFound > 0 Then
'Using the diagram above, we need to append the "B"s
'and "X"s onto sReturn; then advance lIndex so that
'it points to the 1st character of the "C" area.
sReturn = sReturn _
& Mid$(sSource, lIndex, lFound - lIndex) _
& sReplace
lIndex = lFound + lLength
'Allow one fewer replacements
lCount = lCount - 1
End If
Loop Until (lCount = 0) Or (lFound = 0)
'The following senario now exists:
'
' sReturn = RRRRR
' sSource = AAAAABBBBB
' |
' lIndex
'
'Each of the groups of letters represents the following:
' "A"s = Previously searched area.
' "B"s = The area between the last match and the end of
' sSource
' "R"s = The return value. This is the "A" area with all
' appropriate replacements applied.
'It's important to note that any of the groups might be
'equal to "" (but not both "A"s and "B"s).
'
'All that's left to do is append the "B"s to sReturn.
MyReplace = sReturn & Mid$(sSource, lIndex)
End Function
If you've read the topic Working with very long strings earlier in this section (Tips & Tricks), you'll realize that all the string concatenations we're doing to replace substrings could carry a significant performance penalty - especially if the strings are very long and/or there are many replacements to be made. Aside from using the API and byte arrays (a topic that I'm going to pursue), there's not too much we can do about the concatenations. However, there is a special case: If both sSearch and sReplace were the same length, then the replacements could be done using the Mid$ command. Only three lines of the code need to change. For brevity's sake, I've only listed the section of code that requires changes:
'Loop initialization.
sReturn = ""
sReturn = sSource
lIndex = 1
'Keep searching until we're not allowed to make further
'replacements or there are no replacements left to make.
Do
lFound = InStr(lIndex, sString, sSearch)
'Is there a match?
If lFound > 0 Then
sReturn = sReturn _
& Mid$(sSource, lIndex, lFound - lIndex) _
& sReplace
Mid$(sReturn, lFound) = sReplace
lIndex = lFound + lLength
'Allow one fewer replacements
lCount = lCount - 1
End If
Loop Until (lCount = 0) Or (lFound = 0)
MyReplace = sReturn & Mid$(sSource, lIndex)
MyReplace = sReturn
To combine both methods, you could either conditionally execute these three lines of code or have MyReplace call a separate routine when it recognizes the special condition: Len(sSearch) = Len(sReplace). I'll leave the implementation as an exercise for the reader.
Splitting a string (without Split)
Nearly all the functionality of Split has been duplicated. The only significant difference is the parameter fBinary. In Visual Basic version 6.0, this parameter uses an enumerated type. Since earlier versions wouldn't have the enumerated type, I've chosen to implement it as a boolean value.
'------------------------------------------------
'MySplit - Splits a string into substrings.
'
'Parameters:
' sSource - String to split.
' sDelimiter - Delimiting string between substrings. If
' not provided, use a space.
' lCount - The maximum # of substrings to return.
' If not provided, return all possible
' substrings.
' fBinary - True if doing a binary search (case
' sensitive) for sDelimiter; False if doing a
' text search (case insensitive). If not
' provided, True will be assumed.
'
'Returns:
' Returns a zero-based array of substrings.
Public Function MySplit(ByVal sSource As String, _
Optional ByVal sDelimiter = " ", _
Optional ByVal lCount = -1, _
Optional ByVal fBinary = True) _
As Variant
Dim lIndex As Long 'Index into sSource of last match
Dim lFound As Long 'Index into sSource of current match
Dim lLength As Long 'Length of sDelimiter
Dim sString As String 'Copy of sSource used in searching
Dim sReturn() As String 'Array of return substrings
'How many splits are we allowed to make?
If lCount = -1 Then
'Make all possible splits. If sSource contains only
'delimiting characters, the most substrings there
'can be is one plus the # of characters in sSource.
lCount = Len(sSource) + 1
ElseIf lCount < 0 Then
'Invalid value.
Err.Raise 5
ElseIf (lCount = 0) Or (Len(sSource) = 0) Then
'User requests zero splits or there is nothing to
'split - return nothing. I must use the Array()
'function so that the LBound & UBound functions will
'work with an empty return value. Using sReturn will
'cause an error.
MySplit = Array()
Exit Function
End If
'Initialize a spot for the 1st substring.
ReDim sReturn(0 To 0) As String
'Do we have a delimiter? Can we make any splits?
lLength = Len(sDelimiter)
If (lLength = 0) Or (lCount = 1) Then
'There's no delimiter or we can only have a single
'split, return sSource as the only substring.
sReturn(0) = sSource
MySplit = sReturn
Exit Function
End If
'Search with regard to case?
If fBinary Then
'Case is important, leave it along.
sString = sSource
Else
'Ignore case by converting both strings to the same case.
sString = UCase$(sSource)
sDelimiter = UCase$(sDelimiter)
End If
'Loop initialization.
lIndex = 1
'During the loop, the following scenario exists:
'
' sDelimiter = DDDDD
' sSource = AAAAABBBBBDDDDDCCCCC
' | |
' lIndex lFound
'
'Each of the groups of letters represents the following:
' "A"s = Previously searched area.
' "B"s = The area between the last and the current delimiter.
' "C"s = The area after the current delimiter.
' "D"s = The current delimiter found.
'It's important to note that any of the groups, except the
'"D"s might be equal to "".
'Keep searching until we're not allowed to make further
'splits or there are no delimiters left in sSource.
Do
lFound = InStr(lIndex, sString, sDelimiter)
'Is there a match?
If lFound > 0 Then
'Using the diagram above, we need to extract the "B"s
'into a substring; then advance lIndex so that it
'points to the 1st character of the "C" area.
ReDim Preserve sReturn(0 To UBound(sReturn) + 1) As String
sReturn(UBound(sReturn) - 1) = Mid$(sSource, _
lIndex, _
lFound - lIndex)
lIndex = lFound + lLength
'Allow one fewer splits
lCount = lCount - 1
End If
Loop Until (lCount = 1) Or (lFound = 0)
'In the loop termination condition above, you'll note that
'lCount is equal to one when we leave the loop. This is
'to accomodate the last substring we'll be adding below.
'The following senario now exists:
'
' sSource = AAAAABBBBB
' |
' lIndex
'
'Each of the groups of letters represents the following:
' "A"s = Previously searched area.
' "B"s = The area between the last match and the end of
' sSource
'It's important to note that either of the groups (but not
'both) might be equal to "".
'
'All that's left to do is add the "B"s as a token.
sReturn(UBound(sReturn)) = Mid$(sSource, lIndex)
MySplit = sReturn
End Function
Concatenating the strings in an array (without Join)
Nearly all the functionality of Join has been duplicated. The only significant difference is that this routine does not allow an undimensioned array to be passed-in. An example of an undimensioned array:
Dim sArray() As String
This is a minor omission which can easily be corrected with a few lines of error handling code. I'll leave the implementation to the reader.
'------------------------------------------------
'MyJoin - Concatenate substrings in an array.
'
'Parameters:
' sArray - Array of substrings to join.
' sDelimiter - Delimiting string to place between each
' substring. If not provided, a space is used.
'
'Returns:
' Returns a composite string of all the substrings.
Public Function MyJoin(ByVal sArray As Variant, _
Optional ByVal sDelimiter = " ") _
As String
Dim lIndex As Long 'Index into sArray
Dim sResult As String 'Resulting composite string
sResult = ""
'Processes each substring in the array.
For lIndex = LBound(sArray) To UBound(sArray)
'The last substring does not get a delimiter after it.
If lIndex = UBound(sArray) Then
sResult = sResult & sArray(lIndex)
Else
sResult = sResult & sArray(lIndex) & sDelimiter
End If
Next
MyJoin = sResult
End Function
If you've read the topic Working with very long strings earlier in this section (Tips & Tricks), you'll realize that all the string concatenations we're doing to join the substrings could carry a significant performance penalty - especially if the strings are very long and/or there are many concatenation operations to be performed. Implementing a version that uses the Mid$ command would eliminate these performance issues.
To implement such an approach, we would need to asertain the length of the resulting string before we began processing the individual substrings. This is actually quite easily accomplished:
The length of the result = (the total lengths of all the substrings) + ( (the length of the delimiter) * (the number of substrings - 1) )
This assumes that there is at least one substring; however, this is not an unreasonable assumption - especially since undimensioned arrays are not allowed. An implementation of MyJoin that uses the Mid$ command follows:
'------------------------------------------------
'MyJoin - Concatenate substrings in an array.
'
'Parameters:
' sArray - Array of substrings to join.
' sDelimiter - Delimiting string to place between each
' substring. If not provided, a space is used.
'
'Returns:
' Returns a composite string of all the substrings.
Public Function MyJoin(ByVal sArray As Variant, _
Optional ByVal sDelimiter = " ") _
As String
Dim lIndex As Long 'Index into sArray
Dim sResult As String 'Resulting composite string
Dim lResult As Long 'Index into sResult
Dim lLength As Long 'Predicted length of sResult
Dim lCount As Long 'The # of substrings
'Sum the lengths of all the substrings.
lLength = 0
For lIndex = LBound(sArray) To UBound(sArray)
lLength = lLength + Len(sArray(lIndex))
Next
'Add-in the length of all the delimiters that will be used.
lCount = UBound(sArray) - LBound(sArray) + 1
lLength = lLength + (Len(sDelimiter) * (lCount - 1))
'Initialize the resulting string to the proper length.
sResult = Space$(lLength)
lResult = 1
'Processes each substring in the array - starting with
'the first.
lIndex = LBound(sArray)
'Process until the resulting string has been filled.
Do While (lResult <= lLength)
'Overlay the substring.
Mid$(sResult, lResult) = sArray(lIndex)
lResult = lResult + Len(sArray(lIndex))
lIndex = lIndex + 1
'The last substring does not get a delimiter after it.
If lResult > lLength Then
Exit Do
End If
'Overlay the delimiter.
Mid$(sResult, lResult) = sDelimiter
lResult = lResult + Len(sDelimiter)
Loop
MyJoin = sResult
End Function
Filtering an array of strings (without Filter)
Nearly all the functionality of Filter has been duplicated. The only significant difference is the parameter fBinary. In Visual Basic version 6.0, this parameter uses an enumerated type. Since earlier versions wouldn't have the enumerated type, I've chosen to implement it as a boolean value.
'------------------------------------------------
'MyFilter - Filter an array of strings.
'
'Parameters:
' sArray - String to filter.
' sSearch - Filtering string.
' fInclude - True if strings in sArray that contain sSearch
' are to be returned; False if strings in sArray
' that DON'T include sSearch are to be returned.
' If not provided, True will be assumed.
' fBinary - True if doing a binary search (case sensitive);
' False if doing a text search (case insensitive).
' If not provided, True will be assumed.
'
'Returns:
' Returns a zero-based array of strings.
Public Function MyFilter(ByVal sArray As Variant, _
ByVal sSearch As String, _
Optional ByVal fInclude = True, _
Optional ByVal fBinary = True) _
As Variant
Dim lIndex As Long 'Index into sArray
Dim lFound As Long 'Index into sArray of current match
Dim sFilter() As String 'Return array of filtered strings
Dim lCount As Long '# of entries in sFilter()
lCount = 0
For lIndex = LBound(sArray) To UBound(sArray)
'Search with regard to case?
If fBinary Then
'Case is important, leave it alone
lFound = InStr(sArray(lIndex), sSearch)
Else
'Ignore case by comparing all in all uppercase.
lFound = InStr(UCase$(sArray(lIndex)), UCase$(sSearch))
End If
'Add this string to the return array if we found a match
'and we're including matches -OR- we didn't find a match
'and we're including non-matches.
If ((lFound > 0) And fInclude) _
Or ((lFound = 0) And (Not fInclude)) Then
ReDim Preserve sFilter(0 To lCount) As String
sFilter(lCount) = sArray(lIndex)
lCount = lCount + 1
End If
Next
'If there's nothing to return, use the Array() function so
'that the LBound & UBound functions will work.
If lCount = 0 Then
MyFilter = Array()
Else
MyFilter = sFilter
End If
End Function
Brian P. Duckworth
<< Prev] [Main >>
