[AccessD] Array questions

Bill Benson bensonforums at gmail.com
Sun Jan 22 02:18:54 CST 2023


My trick probably earn me some groans or ahs depending on your bend.
However since I use matching in arrays so frequently in every application,
I use an instance of Excel to do my matching.

It is only slow for the first (ever) use or until an empty string is passed
which makes the Excel object variable get reset. The rest are (I believe)
as fast as any VBA array match that could ever run, though I have not times
different approaches.

Sub TestIt()
Dim V() As String
Dim iMatchRow As Long
Dim NotAnArray As String

ReDim V(1 To 4)
V(1) = ""
V(2) = "Benson"
V(3) = "x"
V(4) = 5

iMatchRow = GetRow("Benson", V) 'Tests with base 1 array
Debug.Print iMatchRow


Erase V
iMatchRow = GetRow("Benson", V) 'Tests with empty array
Debug.Print iMatchRow

ReDim V(0 To 3) 'Tests with base 0 array
V(0) = "Benson"
V(1) = "cat"
V(2) = "x"
V(3) = 5
iMatchRow = GetRow("Benson", V)
Debug.Print iMatchRow

iMatchRow = GetRow("Benson", NotAnArray) 'Tests with non-array
Debug.Print iMatchRow


Call GetRow 'Quit Exel

End Sub
Function GetRow(Optional strValue As String = "", Optional vArray As
Variant) As Long
Static objExcel As Object
Dim vRowMatched As Variant
Dim iLB As Long

GetRow = -1
If strValue = "" Then
    If Not objExcel Is Nothing Then
        objExcel.Quit
        Set objExcel = Nothing
    End If
    GoTo ExitFunction
Else
    On Error Resume Next
    iLB = -1
    iLB = LBound(vArray)
    If Err <> 0 Then
        GoTo ExitFunction
    Else
        On Error GoTo 0
        If objExcel Is Nothing Then
            Set objExcel = CreateObject("Excel.Application")
        End If
        With objExcel.Application
            GetRow = .match(strValue, vArray) - IIf(iLB = 0, 1, 0)
        End With
    End If
End If
ExitFunction:

End Function


More information about the AccessD mailing list