2
\$\begingroup\$

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
\$\endgroup\$
3
\$\begingroup\$

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.
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.