VB6Parse / Library / Arrays / filter

VB6 Library Reference

Filter Function

Returns a zero-based array containing a subset of a string array based on specified filter criteria.

Syntax

Filter(sourcearray, match[, include[, compare]])

Parameters

Return Value

Returns a Variant containing a zero-based array of strings. If no matches are found, Filter returns an empty array. If sourcearray is Null or not a one-dimensional array, an error occurs.

Remarks

The Filter function searches a string array for elements containing a specified substring and returns a new array with matching (or non-matching) elements. This is useful for filtering lists, implementing search functionality, and processing string collections.

Important Characteristics:

Typical Uses

Examples

Basic Usage

Dim fruits() As String
Dim filtered() As String

fruits = Array("Apple", "Banana", "Cherry", "Date", "Elderberry")

' Find fruits containing "e" (case-sensitive)
filtered = Filter(fruits, "e")
' Returns: "Apple", "Cherry", "Date", "Elderberry"

' Find fruits NOT containing "e"
filtered = Filter(fruits, "e", False)
' Returns: "Banana"

' Find fruits containing "a" (case-insensitive)
filtered = Filter(fruits, "a", True, vbTextCompare)
' Returns: "Apple", "Banana", "Date"

Case-Sensitive vs Case-Insensitive

Dim names() As String
names = Array("John", "jane", "JAMES", "Julia", "jack")

' Case-sensitive search (default)
Dim result1() As String
result1 = Filter(names, "J")
' Returns: "John", "JAMES", "Julia"

' Case-insensitive search
Dim result2() As String
result2 = Filter(names, "J", True, vbTextCompare)
' Returns: "John", "jane", "JAMES", "Julia", "jack"

Exclude Matches

Dim files() As String
files = Array("data.txt", "backup.bak", "report.txt", "temp.bak", "notes.txt")

' Get only non-backup files (exclude .bak)
Dim textFiles() As String
textFiles = Filter(files, ".bak", False)
' Returns: "data.txt", "report.txt", "notes.txt"

Common Patterns

Filter List Based on User Input

Function SearchList(items() As String, searchTerm As String) As String()
On Error GoTo ErrorHandler

If Trim(searchTerm) = "" Then
' Return all items if search is empty
SearchList = items
Else
' Return filtered items (case-insensitive)
SearchList = Filter(items, searchTerm, True, vbTextCompare)
End If

Exit Function

ErrorHandler:
' Return empty array on error
Dim emptyArray() As String
ReDim emptyArray(0 To -1)
SearchList = emptyArray
End Function

Count Matching Items

Function CountMatches(items() As String, searchTerm As String) As Long
On Error GoTo ErrorHandler

Dim matches() As String
matches = Filter(items, searchTerm, True, vbTextCompare)

' Check if array is empty
If UBound(matches) >= 0 Then
CountMatches = UBound(matches) + 1
Else
CountMatches = 0
End If

Exit Function

ErrorHandler:
CountMatches = 0
End Function

Filter File List by Extension

Function GetFilesByExtension(files() As String, extension As String) As String()
' Ensure extension starts with dot
If Left(extension, 1) <> "." Then
extension = "." & extension
End If

' Filter for files with this extension
GetFilesByExtension = Filter(files, extension, True, vbTextCompare)
End Function

' Usage
Dim allFiles() As String
Dim txtFiles() As String
allFiles = Array("doc1.txt", "image.jpg", "data.txt", "photo.png")
txtFiles = GetFilesByExtension(allFiles, ".txt")

Multiple Filter Criteria

Function FilterMultiple(items() As String, filters() As String) As String()
Dim result() As String
Dim temp() As String
Dim i As Long

result = items

' Apply each filter sequentially
For i = LBound(filters) To UBound(filters)
temp = Filter(result, filters(i), True, vbTextCompare)
result = temp

' Exit early if no matches
If UBound(result) < 0 Then Exit For
Next i

FilterMultiple = result
End Function

' Usage: Find items containing both "test" and "data"
Dim criteria() As String
criteria = Array("test", "data")
filtered = FilterMultiple(sourceArray, criteria)

Populate ListBox with Filtered Results

Sub UpdateFilteredList(lstBox As ListBox, items() As String, searchText As String)
Dim filtered() As String
Dim i As Long

lstBox.Clear

On Error GoTo ErrorHandler

If Trim(searchText) = "" Then
' Show all items
For i = LBound(items) To UBound(items)
lstBox.AddItem items(i)
Next i
Else
' Show filtered items
filtered = Filter(items, searchText, True, vbTextCompare)

If UBound(filtered) >= 0 Then
For i = 0 To UBound(filtered)
lstBox.AddItem filtered(i)
Next i
End If
End If

Exit Sub

ErrorHandler:
' Handle errors silently or show message
End Sub

Remove Duplicates with Filter

Function RemoveDuplicates(items() As String) As String()
Dim result() As String
Dim dict As Object
Dim i As Long
Dim count As Long

Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare

' Add unique items to dictionary
For i = LBound(items) To UBound(items)
If Not dict.Exists(items(i)) Then
dict.Add items(i), Nothing
End If
Next i

' Convert to array
ReDim result(0 To dict.Count - 1)
count = 0
For i = 0 To dict.Count - 1
result(count) = dict.Keys()(i)
count = count + 1
Next i

RemoveDuplicates = result
End Function

Filter with Wildcard Simulation

Function FilterWildcard(items() As String, pattern As String) As Collection
' Simple wildcard: * at start, end, or both
Dim results As New Collection
Dim filtered() As String
Dim searchTerm As String
Dim i As Long
Dim item As String

If Left(pattern, 1) = "*" And Right(pattern, 1) = "*" Then
' Contains search
searchTerm = Mid(pattern, 2, Len(pattern) - 2)
filtered = Filter(items, searchTerm, True, vbTextCompare)

For i = 0 To UBound(filtered)
results.Add filtered(i)
Next i

ElseIf Left(pattern, 1) = "*" Then
' Ends with search
searchTerm = Mid(pattern, 2)
For i = LBound(items) To UBound(items)
If Right(LCase(items(i)), Len(searchTerm)) = LCase(searchTerm) Then
results.Add items(i)
End If
Next i

ElseIf Right(pattern, 1) = "*" Then
' Starts with search
searchTerm = Left(pattern, Len(pattern) - 1)
For i = LBound(items) To UBound(items)
If Left(LCase(items(i)), Len(searchTerm)) = LCase(searchTerm) Then
results.Add items(i)
End If
Next i

Else
' Exact match
For i = LBound(items) To UBound(items)
If LCase(items(i)) = LCase(pattern) Then
results.Add items(i)
End If
Next i
End If

Set FilterWildcard = results
End Function

Autocomplete Implementation

Sub TextBox_Change()
Dim allItems() As String
Dim matches() As String
Dim i As Long

' Get all possible values (from database, array, etc.)
allItems = GetAllItemNames()

If Len(Me.txtSearch.Text) > 0 Then
' Filter items that start with typed text
matches = Filter(allItems, Me.txtSearch.Text, True, vbTextCompare)

' Display suggestions
Me.lstSuggestions.Clear

If UBound(matches) >= 0 Then
For i = 0 To UBound(matches)
Me.lstSuggestions.AddItem matches(i)
Next i
Me.lstSuggestions.Visible = True
Else
Me.lstSuggestions.Visible = False
End If
Else
Me.lstSuggestions.Visible = False
End If
End Sub

Filter Log Entries

Function FilterLogsByLevel(logEntries() As String, level As String) As String()
' Assume log format: "[LEVEL] Message"
Dim levelTag As String
levelTag = "[" & UCase(level) & "]"

FilterLogsByLevel = Filter(logEntries, levelTag, True, vbTextCompare)
End Function

' Usage
Dim logs() As String
Dim errors() As String
logs = Array("[INFO] Started", "[ERROR] Failed", "[INFO] Complete", "[ERROR] Timeout")
errors = FilterLogsByLevel(logs, "ERROR")
' Returns: "[ERROR] Failed", "[ERROR] Timeout"

Check If Array Contains Value

Function ArrayContains(items() As String, value As String, _
Optional caseSensitive As Boolean = False) As Boolean
On Error GoTo ErrorHandler

Dim matches() As String
Dim compareMode As VbCompareMethod

If caseSensitive Then
compareMode = vbBinaryCompare
Else
compareMode = vbTextCompare
End If

matches = Filter(items, value, True, compareMode)

' Check if any exact matches
Dim i As Long
For i = 0 To UBound(matches)
If StrComp(matches(i), value, compareMode) = 0 Then
ArrayContains = True
Exit Function
End If
Next i

ArrayContains = False
Exit Function

ErrorHandler:
ArrayContains = False
End Function

Combine Include and Exclude Filters

Function FilterIncludeExclude(items() As String, includeText As String, _
excludeText As String) As String()
Dim temp() As String

' First include items containing includeText
If includeText <> "" Then
temp = Filter(items, includeText, True, vbTextCompare)
Else
temp = items
End If

' Then exclude items containing excludeText
If excludeText <> "" And UBound(temp) >= 0 Then
temp = Filter(temp, excludeText, False, vbTextCompare)
End If

FilterIncludeExclude = temp
End Function

' Usage: Get .txt files but not backup files
filtered = FilterIncludeExclude(files, ".txt", "backup")

Advanced Usage

Dynamic Search with Multiple Columns

Type RecordData
ID As String
Name As String
Email As String
Department As String
End Type

Function SearchRecords(records() As RecordData, searchTerm As String) As Long()
' Search across multiple fields and return matching indices
Dim names() As String
Dim emails() As String
Dim departments() As String
Dim matchedNames() As String
Dim matchedEmails() As String
Dim matchedDepts() As String
Dim results() As Long
Dim i As Long
Dim count As Long
Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

' Build arrays for each searchable field
ReDim names(LBound(records) To UBound(records))
ReDim emails(LBound(records) To UBound(records))
ReDim departments(LBound(records) To UBound(records))

For i = LBound(records) To UBound(records)
names(i) = records(i).Name
emails(i) = records(i).Email
departments(i) = records(i).Department
Next i

' Filter each field
On Error Resume Next
matchedNames = Filter(names, searchTerm, True, vbTextCompare)
matchedEmails = Filter(emails, searchTerm, True, vbTextCompare)
matchedDepts = Filter(departments, searchTerm, True, vbTextCompare)
On Error GoTo 0

' Collect unique matching indices
For i = LBound(records) To UBound(records)
If InStr(1, records(i).Name, searchTerm, vbTextCompare) > 0 Or _
InStr(1, records(i).Email, searchTerm, vbTextCompare) > 0 Or _
InStr(1, records(i).Department, searchTerm, vbTextCompare) > 0 Then

If Not dict.Exists(i) Then
dict.Add i, Nothing
End If
End If
Next i

' Convert to array
If dict.Count > 0 Then
ReDim results(0 To dict.Count - 1)
For i = 0 To dict.Count - 1
results(i) = dict.Keys()(i)
Next i
Else
ReDim results(0 To -1)
End If

SearchRecords = results
End Function

Incremental Filter (Type-Ahead)

Private lastSearch As String
Private cachedResults() As String

Sub IncrementalSearch(items() As String, currentSearch As String)
Dim filtered() As String

' If new search starts with last search, filter cached results
If Len(currentSearch) > Len(lastSearch) And _
Left(currentSearch, Len(lastSearch)) = lastSearch And _
UBound(cachedResults) >= 0 Then

' Filter from cached results (faster)
filtered = Filter(cachedResults, currentSearch, True, vbTextCompare)
Else
' Filter from full list
filtered = Filter(items, currentSearch, True, vbTextCompare)
End If

' Update cache
cachedResults = filtered
lastSearch = currentSearch

' Display results
DisplayResults filtered
End Sub

Category-Based Filtering

Type Product
Name As String
Category As String
Price As Double
Description As String
End Type

Function FilterProductsByCategory(products() As Product, _
category As String) As Product()
Dim categories() As String
Dim filtered() As String
Dim results() As Product
Dim i As Long
Dim count As Long

' Build category array
ReDim categories(LBound(products) To UBound(products))
For i = LBound(products) To UBound(products)
categories(i) = products(i).Category
Next i

' Get matching categories
filtered = Filter(categories, category, True, vbTextCompare)

' Build result array
ReDim results(0 To UBound(filtered))
count = 0

For i = LBound(products) To UBound(products)
If InStr(1, products(i).Category, category, vbTextCompare) > 0 Then
results(count) = products(i)
count = count + 1
End If
Next i

If count > 0 Then
ReDim Preserve results(0 To count - 1)
Else
ReDim results(0 To -1)
End If

FilterProductsByCategory = results
End Function

Filter with Performance Tracking

Function FilterWithStats(items() As String, searchTerm As String, _
ByRef matchCount As Long, _
ByRef elapsedMs As Double) As String()
Dim startTime As Double
Dim results() As String

startTime = Timer

On Error GoTo ErrorHandler
results = Filter(items, searchTerm, True, vbTextCompare)

If UBound(results) >= 0 Then
matchCount = UBound(results) + 1
Else
matchCount = 0
End If

elapsedMs = (Timer - startTime) * 1000

FilterWithStats = results
Exit Function

ErrorHandler:
matchCount = 0
elapsedMs = 0
ReDim results(0 To -1)
FilterWithStats = results
End Function

Smart Case-Sensitive Filter

Function SmartFilter(items() As String, searchTerm As String) As String()
Dim compareMode As VbCompareMethod

' If search term has uppercase letters, use case-sensitive
' Otherwise use case-insensitive
If searchTerm <> LCase(searchTerm) Then
compareMode = vbBinaryCompare
Else
compareMode = vbTextCompare
End If

SmartFilter = Filter(items, searchTerm, True, compareMode)
End Function

Error Handling

Function SafeFilter(items As Variant, searchTerm As String) As Variant
On Error GoTo ErrorHandler

Dim emptyArray() As String

' Check if items is an array
If Not IsArray(items) Then
ReDim emptyArray(0 To -1)
SafeFilter = emptyArray
Exit Function
End If

' Check if items is Null
If IsNull(items) Then
ReDim emptyArray(0 To -1)
SafeFilter = emptyArray
Exit Function
End If

' Perform filter
SafeFilter = Filter(items, searchTerm, True, vbTextCompare)
Exit Function

ErrorHandler:
Select Case Err.Number
Case 13  ' Type mismatch
Debug.Print "Filter error: sourcearray is not a string array"
Case 5   ' Invalid procedure call
Debug.Print "Filter error: sourcearray is multi-dimensional"
Case 94  ' Invalid use of Null
Debug.Print "Filter error: sourcearray is Null"
Case Else
Debug.Print "Filter error " & Err.Number & ": " & Err.Description
End Select

ReDim emptyArray(0 To -1)
SafeFilter = emptyArray
End Function

Common Errors

Performance Considerations

Best Practices

Always Check Result Array

Dim results() As String
results = Filter(items, searchTerm)

If UBound(results) >= 0 Then
' Process results
For i = 0 To UBound(results)
Debug.Print results(i)
Next i
Else
Debug.Print "No matches found"
End If

Use Error Handling

On Error Resume Next
filtered = Filter(sourceArray, searchText, True, vbTextCompare)
If Err.Number <> 0 Then
' Handle error
ReDim filtered(0 To -1)
End If
On Error GoTo 0

Default to Case-Insensitive for User Input

' Good - User-friendly search
results = Filter(items, userInput, True, vbTextCompare)

' Less friendly - Exact case required
results = Filter(items, userInput)

Comparison with Other Approaches

Filter vs Manual Loop

' Using Filter (concise)
matches = Filter(items, searchTerm, True, vbTextCompare)

' Manual loop (more control)
ReDim matches(0 To UBound(items))
count = 0
For i = LBound(items) To UBound(items)
If InStr(1, items(i), searchTerm, vbTextCompare) > 0 Then
matches(count) = items(i)
count = count + 1
End If
Next i
If count > 0 Then
ReDim Preserve matches(0 To count - 1)
End If

Filter vs Collection/Dictionary

' Filter - Returns array
Dim arr() As String
arr = Filter(items, searchTerm)

' Collection - More flexible but slower
Dim coll As New Collection
For i = LBound(items) To UBound(items)
If InStr(1, items(i), searchTerm, vbTextCompare) > 0 Then
coll.Add items(i)
End If
Next i

Limitations

← Back to Arrays | View all functions