3
\$\begingroup\$

Given an array and a string and bounds within which to search, I need to find the position of the string within those bounds.

What I want to optimise:

If possible, I want to re-design the function so that it doesn't have 10 optional arguments, some of which are not actually optional depending on the size of the array being passed.

Having bounds for each dimension of the array is important because I might be after, for example, a string in the headings which could also appear elsewhere in the array.

I also don't like passing the arguments as variants but I needed a non-integer value to correspond to "L/U bound of the array".

The function itself also feels rather inelegant. It feels like there should be a much simpler way to implement what I'm trying to do.

Any suggestions on how to improve the above, including splitting it into a combination of subs/functions would be much appreciated. General suggestions about good coding practice also much appreciated.

Brief description of macro flow:

  1. select case for number of dimensions in the array
  2. Check that all the required variables for that size have values
  3. Iterate through every element within the bounds supplied
  4. If/when the string is found, output the value of the dimension that was requested.

Public Function Array_Position(ByVal varSearch As Variant, ByRef arrSearchArray() As Variant, ByVal lngNumberOfDimensions As Long, ByVal lngDimensionToSearch As Long, _
    Optional ByVal lngFirstDimensionLbound As Variant, Optional ByVal lngFirstDimensionUbound As Variant, _
    Optional ByVal lngSecondDimensionLbound As Variant, Optional ByVal lngSecondDimensionUbound As Variant, _
    Optional ByVal lngThirdDimensionLbound As Variant, Optional ByVal lngThirdDimensionUbound As Variant, _
    Optional ByVal lngFourthDimensionLbound As Variant, Optional ByVal lngFourthDimensionUbound As Variant, _
    Optional ByVal lngFifthDimensionLbound As Variant, Optional ByVal lngFifthDimensionUbound As Variant)

    '/======================================================================================================================================================
    '/  Author:  Zak Armstrong
    '/  Email:   -
    '/  Date:    14/August/2015
    '/
    '/  Is Called By:   -
    '/
    '/  Calls:          None
    '/
    '/  Description:    General "Find position of string in dimension of Array" Sub
    '/
    '/                  N.B. only accepts arrays up to 5 dimensions
    '/
    '/                  Returns null if no match found
    '/======================================================================================================================================================
    Dim I As Long
    Dim J As Long
    Dim K As Long
    Dim L As Long
    Dim M As Long

    Dim bMatchFound As Boolean

    Dim varPosition As Variant
    '/======================================================================================================================================================

    On Error Resume Next
    If lngFirstDimensionLbound = "all" Then lngFirstDimensionLbound = LBound(arrSearchArray, 1)
    If lngSecondDimensionLbound = "all" Then lngSecondDimensionLbound = LBound(arrSearchArray, 2)
    If lngThirdDimensionLbound = "all" Then lngThirdDimensionLbound = LBound(arrSearchArray, 3)
    If lngFourthDimensionLbound = "all" Then lngFourthDimensionLbound = LBound(arrSearchArray, 4)
    If lngFifthDimensionLbound = "all" Then lngFifthDimensionLbound = LBound(arrSearchArray, 5)

    If lngFirstDimensionUbound = "all" Then lngFirstDimensionUbound = UBound(arrSearchArray, 1)
    If lngSecondDimensionUbound = "all" Then lngSecondDimensionUbound = UBound(arrSearchArray, 2)
    If lngThirdDimensionUbound = "all" Then lngThirdDimensionUbound = UBound(arrSearchArray, 3)
    If lngFourthDimensionUbound = "all" Then lngFourthDimensionUbound = UBound(arrSearchArray, 4)
    If lngFifthDimensionUbound = "all" Then lngFifthDimensionUbound = UBound(arrSearchArray, 5)
    On Error GoTo 0

    bMatchFound = False
    varPosition = Null

        Select Case lngNumberOfDimensions

            Case Is = 1
            If IsMissing(lngFirstDimensionLbound) Or IsMissing(lngFirstDimensionUbound) Then Call Array_Position_Error

                For I = lngFirstDimensionLbound To lngFirstDimensionUbound
                    If arrSearchArray(I) = varSearch _
                        Then
                            varPosition = I
                            bMatchFound = True
                    End If
                Next I


            Case Is = 2
            If IsMissing(lngFirstDimensionLbound) Or IsMissing(lngFirstDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngSecondDimensionLbound) Or IsMissing(lngSecondDimensionUbound) Then Call Array_Position_Error

                For I = lngFirstDimensionLbound To lngFirstDimensionUbound
                For J = lngSecondDimensionLbound To lngSecondDimensionUbound
                    If arrSearchArray(I, J) = varSearch _
                        Then
                            Select Case lngDimensionToSearch

                                Case Is = 1
                                    varPosition = I
                                    bMatchFound = True


                                Case Is = 2
                                    varPosition = J
                                    bMatchFound = True

                            End Select
                    End If
                Next J
                Next I


            Case Is = 3
            If IsMissing(lngFirstDimensionLbound) Or IsMissing(lngFirstDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngSecondDimensionLbound) Or IsMissing(lngSecondDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngThirdDimensionLbound) Or IsMissing(lngThirdDimensionUbound) Then Call Array_Position_Error

                For I = lngFirstDimensionLbound To lngFirstDimensionUbound
                For J = lngSecondDimensionLbound To lngSecondDimensionUbound
                For K = lngThirdDimensionLbound To lngThirdDimensionUbound
                    If arrSearchArray(I, J, K) = varSearch _
                        Then
                            Select Case lngDimensionToSearch


                                Case Is = 1
                                    varPosition = I
                                    bMatchFound = True


                                Case Is = 2
                                    varPosition = J
                                    bMatchFound = True


                                Case Is = 3
                                    varPosition = K
                                    bMatchFound = True


                            End Select
                    End If
                Next K
                Next J
                Next I


            Case Is = 4
            If IsMissing(lngFirstDimensionLbound) Or IsMissing(lngFirstDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngSecondDimensionLbound) Or IsMissing(lngSecondDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngThirdDimensionLbound) Or IsMissing(lngThirdDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngFourthDimensionLbound) Or IsMissing(lngFourthDimensionUbound) Then Call Array_Position_Error

                For I = lngFirstDimensionLbound To lngFirstDimensionUbound
                For J = lngSecondDimensionLbound To lngSecondDimensionUbound
                For K = lngThirdDimensionLbound To lngThirdDimensionUbound
                For L = lngFourthDimensionLbound To lngFourthDimensionUbound
                    If arrSearchArray(I, J, K, L) = varSearch _
                        Then
                            Select Case lngDimensionToSearch


                                Case Is = 1
                                    varPosition = I
                                    bMatchFound = True


                                Case Is = 2
                                    varPosition = J
                                    bMatchFound = True


                                Case Is = 3
                                    varPosition = K
                                    bMatchFound = True


                                Case Is = 4
                                    varPosition = L
                                    bMatchFound = True


                            End Select
                    End If
                Next L
                Next K
                Next J
                Next I


            Case Is = 5
            If IsMissing(lngFirstDimensionLbound) Or IsMissing(lngFirstDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngSecondDimensionLbound) Or IsMissing(lngSecondDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngThirdDimensionLbound) Or IsMissing(lngThirdDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngFourthDimensionLbound) Or IsMissing(lngFourthDimensionUbound) Then Call Array_Position_Error
            If IsMissing(lngFifthDimensionLbound) Or IsMissing(lngFifthDimensionUbound) Then Call Array_Position_Error

                For I = lngFirstDimensionLbound To lngFirstDimensionUbound
                For J = lngSecondDimensionLbound To lngSecondDimensionUbound
                For K = lngThirdDimensionLbound To lngThirdDimensionUbound
                For L = lngFourthDimensionLbound To lngFourthDimensionUbound
                For M = lngFifthDimensionLbound To lngFifthDimensionUbound
                    If arrSearchArray(I, J, K, L, M) = varSearch _
                        Then
                            Select Case lngDimensionToSearch


                                Case Is = 1
                                    varPosition = I
                                    bMatchFound = True


                                Case Is = 2
                                    varPosition = J
                                    bMatchFound = True


                                Case Is = 3
                                    varPosition = K
                                    bMatchFound = True


                                Case Is = 4
                                    varPosition = L
                                    bMatchFound = True


                                Case Is = 5
                                    varPosition = M
                                    bMatchFound = True


                            End Select

                    End If
                Next M
                Next L
                Next K
                Next J
                Next I

            Case Else
                MsgBox ("varPosition only accepts arrays up to 5 dimensions")
                End

        End Select

    Array_Position = varPosition

End Function
\$\endgroup\$
2
  • \$\begingroup\$ Any comments to describe what's happening and why it's happening? \$\endgroup\$ Commented Aug 20, 2015 at 14:05
  • \$\begingroup\$ Done, hope that helps. \$\endgroup\$ Commented Aug 20, 2015 at 14:27

1 Answer 1

Reset to default
5
\$\begingroup\$

I have a few suggestions, but first a few questions:

Given an array and a string and bounds within which to search, I need to find the position of the string within those bounds

What position exactly, and for what purpose (I think you hinted at the purpose next)?

Having bounds for each dimension of the array is important because I might be after, for example, a string in the headings which could also appear elsewhere in the array.

If the purpose of the function is to help you distinguish between a header and normal data on the sheet, how will you be able to determine that based on the return of your function? Your function returns the index in a specific dimension of the array, but doesn't return the dimension itself: if you get a 5 dimensional array you'll know the string is in position 7 (for example) but you don't know in which dimension.

Next question: do you want to get the position of the first duplicate in the array, or the last dupe?

Last question: I know you are trying to create a generic, multi purpose function to provide flexibility, but working in the VBA environment for Excel, most user will only require a 1 dimensional array, or a 2D one. There is a lot of effort and code ready to accommodate unexpected situations, but I haven't seen too many 5 dimensional arrays. I'd suggest you limit it to a 1D and 2D array (cover 90% of possible scenarios with the least effort).

A few notes:

  • Your return value should be a Long, not a Variant.

  • Your On Error Resume Next section should trigger the end of the function instead of checking every lower and upper bound with IsMissing - an array bound error shows that the array is not valid so no further processing is needed.

  • Once you find a match you could exit all loops and go directly to the end of the function (unless you need to find the last duplicate).

Below is the code I would use for such a function (I'll explain some benefits):

Option Explicit

Public Function GetArrIndxOfStr(ByVal fndStr As String, ByRef arr As Variant) As String

    Dim arrSz() As String, lDim As Long, uDim As Long
    Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
    Dim d1() As String, d2() As String, d3() As String, d4() As String, d5() As String
    Dim findSz As Long, iSz As Long, itm As String, indx As String

    fndStr = Trim(fndStr)                       'cleanup incoming search string
    findSz = Len(fndStr)
    If findSz > 0 Then
        arrSz = Split(GetArrayDims(arr), ",")   'determine all array dimensions
        uDim = UBound(arrSz)                    'if uDim = -1 the array is empty
        If uDim > -1 And uDim < 2 Then          'use uDim < 5 for 5 dimensions
            lDim = LBound(arrSz)
            fndStr = LCase(fndStr)              'case insensitive
            Select Case uDim
                Case 0                          '1D array ------------------------------
                    d1 = Split(arrSz(0), ":")
                    For i1 = d1(0) To d1(1)
                        itm = Trim(arr(i1))
                        iSz = Len(itm)
                        If findSz = iSz Then
                            If LCase(itm) = fndStr Then
                                indx = i1
                                Exit For
                            End If
                        End If
                    Next
                Case 1                          '2D array ------------------------------
                    d1 = Split(arrSz(0), ":")
                    d2 = Split(arrSz(1), ":")
                    For i1 = d1(0) To d1(1)
                        For i2 = d2(0) To d2(1)
                            itm = Trim(arr(i1, i2))
                            iSz = Len(itm)
                            If findSz = iSz Then
                                If LCase(itm) = fndStr Then
                                    GetArrIndxOfStr = i1 & "," & i2
                                    Exit Function
                                End If
                            End If
                        Next
                    Next
            End Select
        End If
    End If
    GetArrIndxOfStr = indx   'string containing an index for each dimension in array
End Function

The above function has only 2 parameters: search string, and array as Variant.

All other parameters were replaced by the function bellow which determines all dimensions, and returns the lower and upper bounds for each dimension.

Public Function GetArrayDims(var As Variant) As String
    On Error GoTo Done

    Dim i As Long, x As String  'Arrays can have no more than 60 dimensions

    Do
        i = i + 1
        x = x & LBound(var, i) & ":" & UBound(var, i) & ","
    Loop While True
Done:
    Err.Clear
    If Len(x) > 0 Then GetArrayDims = Left(x, Len(x) - 1)
End Function

For the tested array testArr(0 To 1, 2 To 3, 4 To 5)

the above function returns: 0:1 , 2:3 , 4:5

Test function:

Public Sub testArrIndxOfString()

    Dim testArr(0 To 1, 2 To 3, 4 To 5) As String, result As String

    testArr(0, 2, 4) = 1
    testArr(0, 2, 5) = vbNullString
    testArr(0, 3, 4) = 3
    testArr(0, 3, 5) = 4
    testArr(1, 2, 4) = 5    '"test"     Debug.Print result: 1,2,4
    testArr(1, 2, 5) = 6
    testArr(1, 3, 4) = 7
    testArr(1, 3, 5) = "test"   '8      Debug.Print result: 1,3,5

    result = GetArrIndxOfStr("test", testArr)

End Sub
\$\endgroup\$

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.