Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Option Explicit
Function FindInArray(fStr As Variant, sArr As Variant) As Variant
On Error GoTo thoat
If IsObject(fStr) Then
If fStr.Columns.Count = 1 And fStr.Rows.Count = 1 Then
fStr = fStr.Value2
Else
Exit Function
End If
End If
fStr = LCase(CStr(fStr))
If IsObject(sArr) Then
If sArr.Count > 1 Then sArr = sArr.Value2
End If
If IsEmpty(sArr) Then Exit Function
If fStr = vbNullString Then
FindInArray = sArr
Exit Function
Else
Dim DK As Boolean, I As Long, J As Long, K As Byte, TMP() As Long, TmpArr
ReDim TmpArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2)) As Byte
ReDim TMP(1 To UBound(sArr, 1)) As Long
TmpArr = sArr
For I = LBound(TmpArr, 1) To UBound(TmpArr, 1)
For K = 1 To UBound(TmpArr, 2)
DK = (LCase(CStr(TmpArr(I, K))) Like "*" & fStr & "*")
If DK Then
J = J + 1
TMP(J) = I
Exit For
End If
Next
Next
If J > 0 Then
Dim Arr As Variant, ID As Long
ReDim Arr(1 To J, 1 To UBound(TmpArr, 2))
For I = 1 To J
ID = TMP(I)
For K = 1 To UBound(TmpArr, 2)
Arr(I, K) = TmpArr(ID, K)
Next
Next
FindInArray = Arr
Exit Function
End If
End If
thoat:
Exit Function
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment