Finding the position of a string in a dimension of an array

Question

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

• Raystafarian: Any comments to describe what's happening and why it's happening?
• Kaz: Done, hope that helps.

Answer 1

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