Finding if a string is in a 2 dimensional VBA Excel array

Question

I have a great function that I use all of the time for a 1 dimensional Excel VBA array that checks if a string is in an array:

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean

    IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)

End Function

Unfortunately it does not work when using it to check for a 2 dimensional array, like I have here:

Sub new_idea_filter()

home_sheet = ActiveSheet.Name

c = 1

Dim myfilters(1 To 4, 1 To 5000)


myfilters(1, 4) = "Test"

If IsInArray("Test", myfilters()) = True Then
    killer = True
End If



End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean

    IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)

End Function

It keeps erroring out in the function saying subscript out of range, anyone have a thought how I can check if a string is in the 2 dimensional array?

Answer 1

I have an Excel users version solution for this as well.

Cant you just split concatenate the array into a single column (1-d array)? you got x columns. who cares about the # of rows for now.

I would do : col 1 & "/// unique character delimiter"& col#1 & col 2 & "/// unique character delimiter"& col#2 & col 3 & "/// unique character delimiter"& col#2 & ... & & col (n-1) & "/// unique character delimiter"& col#(n-1) & & "/// unique character delimiter"& col#n

turning the 2-d array into a 1-d array.

and index match this joined-up array/column, to find the multiple occurances of the string located in the original array.

And whats good about this, because of the unique way you joined it (any unique delimator charavter + col# ) it can and will also tell you the original column each found return value of the string your looking for resided in. SO you dont loose any information.

(you can do that implementing =match ("/"&string&"/")) the position of the looked-for text in the lookup output and the next occurrence of the special unique delimiter & the next (subsequent) col # that's to the right of it.

Doesn't this do the same thing , as the macros above or the question asks for ? and in an (almost) non-macro*/non-vba way?

*see below for why it can be done with out without macros.

So in the end, you can just turn any 2-d N.M array into an 1-d X array, while keeping all the information (of which column the text was originally belonging to) and still do a simple lookup, index-match or a LoopALL function (which is great) :

Lookupall macro to use to find and return multiple found occurrences of string:

Function LookupAll(vVal, rTable As Range, ColumnI As Long) As Variant
Dim rFound As Range, lLoop As Long
Dim strResults As String

With rTable.Columns(1)
Set rFound = .Cells(1, 1)
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, vVal)
Set rFound = .Find(what:=vVal, After:=rFound, LookIn:=xlFormulas, lookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

strResults = strResults & "," & rFound(1, ColumnI)
Next lLoop

End With


LookupAll = Trim(Right(strResults, Len(strResults) - 1))
End Function

Up to you whether you use VBA lookup all function above or an index-match formula in excel which can find and return multiple occurrences of a search find.

Delimation and join of separate columns of an array strips a need for an array search (which I've never been able to do as I wanted - ie. get the results all into 1 cell), and turns it into a single and simpler 1-d array without any information loss.

I believe the speed would be as fast (and accurate) as anything else. Particularly as you've reduced/condensed the array into a single array - 1 column.

Any thoughts?

Answer 2

@Siddharth-Rout answer above is working perfectly with Application.Match in addition to the Filter function :-). - My solution tries to use the OP Filter function only: As the filter function needs a 1dim array, the array is splitted into portions.

A) Alternative solution using the original FILTER function instead of Match plus error handling

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i      As Long

If nDim(arr) = 1 Then
  IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
Else    ' allows using filter function in portions
  For i = 1 To UBound(arr, 2)
      If (UBound(Filter(Application.Transpose(Application.Index(arr, 0, i)), stringToBeFound)) > -1) Then IsInArray = True: Exit For
  Next i
End If
End Function

Helper function to get array Dimension

Function nDim(ByVal vArray As Variant) As Long
' Purp: get number of array dimensions
' Site: http://support.microsoft.com/kb/152288
  Dim dimnum     As Long
  Dim ErrorCheck As Variant
  On Error GoTo FinalDimension
  For dimnum = 1 To 60000
      ErrorCheck = LBound(vArray, dimnum)
  Next

FinalDimension:
  nDim = dimnum - 1
End Function

B) Recursive solution using the original FILTER function instead of Match plus error handling

Function IsInArray(stringToBeFound As String, arr As Variant, Optional i As Long = 0) As Boolean
Select Case i
       Case -1:                                                             ' stop 2dim calls
       Case 0: IsInArray = IsInArray(stringToBeFound, arr, nDim(arr))       ' start recursive call
       Case 1: IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)    ' 1dim array
       Case Else           ' allows using filter function in portions
            If (UBound(Filter(Application.Transpose(Application.Index(arr, 0, i)), stringToBeFound)) > -1) Then
               IsInArray = True
            Else            ' recursive calls (2dim array)
               IsInArray = IsInArray(stringToBeFound, arr, IIf(i + 1 > UBound(arr), -1, i + 1))
            End If
End Select
End Function

Answer 3

If you get the data from a recordset i use this method; first i use GetString for the recordset, second use Split to convert the string in a array unidimensional where each item is a string with all the information. After that you con use the function IsInArray.

The code is:

RecSet.Open strSQL, Cn
RecSet.MoveFirst
RecString = RecSet.GetString(, , ";", vbCr) 'genera una cadena con los datos. Campos separados por ; y registros por vbCR
RecSplit = Split(RecString, vbCr) 'Genera un array unidimensional con la cadena

you can test the code, but remember only works if you get the data from a recordset

Answer 4

As long as you're in Excel (or have a reference to it), you can use the Index function to slice your array into rows or columns.

Public Function IsInArray(ByVal vToFind As Variant, vArr As Variant) As Boolean

    Dim i As Long
    Dim bReturn As Boolean
    Dim vLine As Variant

    For i = LBound(vArr, 1) To UBound(vArr, 1)
        vLine = Application.WorksheetFunction.Index(vArr, i) 'slice off one line
        If IsArray(vLine) Then 'if it's an array, use the filter
            bReturn = UBound(Filter(vLine, vToFind)) > -1
        Else 'if it's not an array, it was 1d so check the value
            bReturn = vLine = vToFind
        End If
        If bReturn Then Exit For 'stop looking if one found
    Next i

    IsInArray = bReturn

End Function

Public Sub test()

    Dim arr() As Variant

    ReDim arr(1 To 2, 1 To 2)
    arr(1, 2) = "Test"
    Debug.Assert IsInArray("Test", arr)

    arr(1, 2) = "Wrong"
    Debug.Assert Not IsInArray("Test", arr)

    ReDim arr(1 To 3)
    arr(2) = "Test"
    Debug.Assert IsInArray("Test", arr)

    arr(2) = "Wrong"
    Debug.Assert Not IsInArray("Test", arr)

    Debug.Print "Passed"

End Sub

Answer 5

Something from my code collection

You can use Application.Match. This will work for both 1D and 2D array :)

See this

Sub Sample()
    Dim myfilters(1 To 4, 1 To 5000)

    myfilters(1, 4) = "Test"

    If IsInArray("Test", myfilters()) = True Then MsgBox "Found"
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    Dim bDimen As Byte, i As Long

    On Error Resume Next
    If IsError(UBound(arr, 2)) Then bDimen = 1 Else bDimen = 2
    On Error GoTo 0

    Select Case bDimen
    Case 1
        On Error Resume Next
        IsInArray = Application.Match(stringToBeFound, arr, 0)
        On Error GoTo 0
    Case 2
        For i = 1 To UBound(arr, 2)
            On Error Resume Next
            IsInArray = Application.Match(stringToBeFound, Application.Index(arr, , i), 0)
            On Error GoTo 0
            If IsInArray = True Then Exit For
        Next
    End Select
End Function

Answer 6

You can try converting your original Function to be able to work with arrays. Please try the following, though note that I have not tested if it works.

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean

    Dim cell As Variant
    For Each cell In arr
        IsInArray = IsInArray Or (UBound(Filter(cell(), stringToBeFound)) > -1)
    Next

End Function

Regards