# A function that tells you if a particular set of data exists in a listbox

I created a function that checks to see if a particular set of data has been added to a listbox and returns a boolean to indicate if the value was found or not.

I am asking for critiques on my code.

EDIT: I just noticed the BasicInclude.DebugMode variable, I use that so that users see a standard messagebox, where when I run through the code, I want to know the line it fails on and the state of variables etc.

Public Function checklist2(ByVal argValue As Variant, ByRef argControl As Control, Optional ByVal argColumn As Variant = 0) As Boolean
If Not BasicInclude.DebugMode Then On Error GoTo Error_Handler Else On Error GoTo 0
Dim i As Long
Dim j As Long
Dim u1 As Long
Dim u2 As Long
Dim start As Long
Dim b As Boolean
If argControl.ControlType = acComboBox Or argControl.ControlType = acListBox Then
If argControl.ColumnHeads Then start = 1 Else start = 0
If VarType(argValue) >= vbArray And VarType(argColumn) >= vbArray Then
u1 = UBound2(argValue)
u2 = UBound2(argColumn)
If u1 > 0 And u2 > 0 Then
If u1 = u2 Then
For i = start To argControl.ListCount - 1
b = True
For j = 0 To u1
If Not (argControl.Column(argColumn(j), i) Like argValue(j)) Then
b = False
End If
Next
If b Then
checklist2 = True
Exit Function
End If
Next
ElseIf u1 > u2 Then
For i = start To argControl.ListCount - 1
b = True
For j = 0 To u2
If Not (argControl.Column(argColumn(j), i) Like argValue(j)) Then
b = False
End If
Next
If b Then
checklist2 = True
Exit Function
End If
Next
Else
For i = start To argControl.ListCount - 1
b = True
For j = 0 To u1
If Not (argControl.Column(argColumn(j), i) Like argValue(j)) Then
b = False
End If
Next
If b Then
checklist2 = True
Exit Function
End If
Next
End If
Else
checklist2 = False
Exit Function
End If
ElseIf VarType(argValue) >= vbArray Then
For i = start To argControl.ListCount - 1
If argControl.Column(argColumn, i) Like argValue(0) Then
checklist2 = True
Exit Function
End If
Next
ElseIf VarType(argColumn) >= vbArray Then
For i = start To argControl.ListCount - 1
If argControl.Column(argColumn(0), i) Like argValue Then
checklist2 = True
Exit Function
End If
Next
Else
For i = start To argControl.ListCount - 1
If argControl.Column(argColumn, i) Like argValue Then
checklist2 = True
Exit Function
End If
Next
End If
End If
checklist2 = False
Error_Exit:
Exit Function
Error_Handler:
StandardErrorBox "checklist2", Err
checklist2 = False
Resume Error_Exit
End Function


It uses two helper functions, Ubound2 which is just a wrapper to catch the error if it has an invalid array,

Public Function UBound2(ByVal argArray As Variant, Optional ByVal argRank As Long = 1) As Long
On Error GoTo Error_Handler                  'Error wrapped version of ubound
Dim out As Long
out = UBound(argArray, argRank)
Error_Exit:
UBound2 = out
Exit Function
Error_Handler:
out = -1
Resume Error_Exit
End Function


and StandardErrorBox because i current cant get vbWatchdog.

Public Sub StandardErrorBox(ByVal argSource As String, ByRef e As ErrObject, Optional ByRef daoE As DAO.Errors = Nothing, Optional ByVal argExtra As String = "", Optional ByVal argSilent As Boolean = False)
Dim msg As String
Dim er As DAO.Error
msg = "The following error(s) has/have occured" & vbCrLf & vbCrLf & "Error Number: " & e.Number & vbCrLf & _
"Error Source: " & e.Source & vbCrLf & _
"Error Description: " & e.Description

If Not daoE Is Nothing Then
If e.Source Like "*[oO][dD][bB][cC]*" Then
msg = msg & vbCrLf & vbCrLf & "DAO errors" & vbCrLf
For Each er In daoE
msg = msg & vbCrLf & "Error Number: " & er.Number & vbCrLf & _
"Error Source: " & er.Source & vbCrLf & _
"Error Description: " & er.Description
Next
End If
End If

If argExtra <> "" Then
msg = msg & vbCrLf & vbCrLf & "Additional Information: " & argExtra
End If
msg = msg & vbCrLf & vbCrLf & "Function: " & argSource
If argSilent Then
MsgBox msg, vbOKOnly + vbCritical, "An Error has Occured!"
Else
Debug.Print msg
End If
End Sub


## Errors and Omissions

The UBound2 function is simply incorrect. You are operating on the assumption that every array is base zero with positive indexing...

Private Sub ExampleOne()
Dim bar() As Long
ReDim bar(-10 To -5)

Dim idx As Long
For idx = LBound(bar) To UBound(bar)
Debug.Print idx
Next
End Sub


...that negative one is a good way to signal an "error with UBound"...

'This is a *super* common idiom for getting an "uninitialized" dynamic array.
Private Sub ExampleTwo()
Dim foo() As String
foo = Split(vbNullString)
Debug.Print LBound(foo), UBound(foo)
End Sub


...and all this wrongness spills over into the main body of your code (my comment):

For j = 0 To u1 '<-- subscript out of range waiting to happen
If Not (argControl.Column(argColumn(j), i) Like argValue(j)) Then
b = False
End If
Next


As to the purpose of the function, that's also unclear. If it's intended to be used as a guard clause against uninitialized dynamic arrays, the only reliable way to do that is to tear the containing VARIANT structure apart and check to see if its data area contains a pointer. For an example of how to do that, you can look at this SO answer. The GetBaseAddress function will return zero if the array you pass it is uninitialized.

Your check to see if a Variant is an array is also wrong:

If VarType(argValue) >= vbArray


The VarType function simply returns the VT_TYPE of the Variant (or expression) that it is passed, and VT_ARRAY is a flag. Your test would return true for an argument that has the VT_BYREF flag set, regardless of whether the VT_ARRAY flag (AKA vbArray) is set. If you really want to use the VarType function to determine if something is an array, you need to test for the flag:

If (VarType(argValue) And vbArray) = vbArray


But there really isn't much point to that, because the built in IsArray function does exactly that:

If IsArray(argValue)


Note also that >= vbArray is superfluous. A Variant with only the vbArray flag set is not a valid Variant. It will always have another flag set, so it will never be equal.

Unless I'm completely missing something, you're using the Like operator as a performance sucking, unclear alternative to = when you do this:

If Not (argControl.Column(argColumn(j), i) Like argValue(j)) Then


Like without wild-cards is not a shortcut for "contains". Unless you've already built the expression inside of the argValue element, that test is exactly the same as this much clearer test:

If argControl.Column(argColumn(j), i) <> argValue(j) Then


Your function signature is misleading for checklist2 (line break added for clarity):

Public Function checklist2(ByVal argValue As Variant, ByRef argControl As Control, _
Optional ByVal argColumn As Variant = 0) As Boolean


First, argColumn is Optional in the signature, but it sure isn't optional here:

If VarType(argValue) >= vbArray And VarType(argColumn) >= vbArray Then


On top of that, the default value doesn't make any sense. If it has to be an array if supplied, then it can't have a default value, simple as that. Default values must be intrinsic types. If it made sense in the context of the function for it to be Optional, it should not have a default. You would then test to see if it was supplied with the IsMissing function:

If IsMissing(argColumn) Then
'do whatever you need to do to establish a "default" value.


## Organization and Flow Control

If statements without an Else block should probably be inverted a couple places in your code. For example...

 If argControl.ControlType = acComboBox Or argControl.ControlType = acListBox Then
'...the rest of the function...
End If


...would be better as this:

If argControl.ControlType <> acComboBox And argControl.ControlType <> acListBox Then
Exit Function
End If


Otherwise you tend to end up with arrow code, and I do have to say that looking at checklist2 makes me want to turn my head to the right.

The assignment of checklist2 = False at the bottom of the function is completely unnecessary, and it makes you use Exit Function all over the place to avoid falling through the default return value. Just let the function exit - if it hasn't been set to True then ...wait for it... it's False.

Speaking of Exit Function, you have exactly 7 exit points in the checklist2 function. That makes it scream "REFACTOR ME". A good place to start would be to extract functions from duplicated code like this:

For i = start To argControl.ListCount - 1
b = True
For j = 0 To u2
If Not (argControl.Column(argColumn(j), i) Like argValue(j)) Then
b = False
End If
Next
If b Then
checklist2 = True
Exit Function
End If
Next


That is easily extracted to something like this...

Private Function ListElementsMatchArray(ByVal listControl As Control, ByVal testArray As Variant, _
ByVal columnArray As Variant, ByVal bound As Long) As Boolean
With listControl
Dim outer As Long
For outer = IIf(.ColumnHeads, 1, 0) To .ListCount - 1
Dim inner As Long
For inner = 0 To bound      '<-- note that the LBound here is still wrong.
If Not (.Column(columnArray(inner), outer) Like testArray(inner)) Then
Exit Function
End If
Next
Next
End With
ListElementsMatchArray = True
End Function


...and called like so:

If u1 = u2 Then
checklist2 = ListElementsMatchArray(argControl, argColumn, argValue, u1)
ElseIf '...


This section of code at the end is kind of tortured:

Error_Exit:
Exit Function
Error_Handler:
StandardErrorBox "checklist2", Err
checklist2 = False
Resume Error_Exit
End Function


Let's assume for the sake of argument that you wind up in your error handler. You display the message box, set the return value to the only value can be in the error handler (pro-tip, you always exit early in you set checklist2 = True - see above), then jump 5 lines above and ... Exit Function. Huh? The entire error handler can be re-written as this:

    Exit Function
Error_Handler:
StandardErrorBox "checklist2", Err
End Function


## Nits and Picks

This line is cringe-worthy difficult to read:

If Not BasicInclude.DebugMode Then On Error GoTo Error_Handler Else On Error GoTo 0


First, On Error GoTo 0 is what you get by default, so there's no point in executing the Else clause at all. Second, this strikes me as something that would be better as a pre-compiler directive. If you want the one-liner, just do this:

If Not BasicInclude.DebugMode Then On Error GoTo Error_Handler


The expanded version is much more readable though:

If Not BasicInclude.DebugMode Then
On Error GoTo Error_Handler
End If


You don't need to "pass" Err around as an ErrObject. There is only one, and Err isn't even an object. It's a function that returns the only ErrObject. This leads you to alias it as the much less descriptive e in your StandardErrorBox procedure.

You shouldn't add bit flags together (or use any other non-bitwise operations on them). Combine them instead. This...

MsgBox msg, vbOKOnly + vbCritical, "An Error has Occured!"


...should be this:

MsgBox msg, vbOKOnly Or vbCritical, "An Error has Occured!"


This is already much longer than I intended, so I'll buzzword the rest and leave them to other reviewers:

• Use meaningful names.
• Declare variables close to use.
• Use vbNullString.
• Pass ByVal unless you're changing the argument.