Filter function for 2 dimensional array in VBA.

There is filter function in VBA for one dimensional array. What about
2 dimensional array?
Below function helps you in filtering 2D array.


Copy below Function in your VBA module.
--------------------------------------------------------------------------- --------------
Public Function filter2dArray(sourceArr As Variant, matchStr As
String) As Variant
Dim matchArrIndex As Variant, splitArr As Variant
Dim i As Integer, outerindex As Integer, innerIndex As Integer,
tempArrayIndex As Integer, CurrIndex As Integer, stringLength As
Integer, matchType As Integer
Dim increaseIndex As Boolean
Dim actualStr As String
splitArr = Split(matchStr, "*")
On Error GoTo errorHandler
If UBound(splitArr) = 0 Then
matchType = 0 'Exact Match
actualStr = matchStr
ElseIf UBound(splitArr) = 1 And splitArr(1) = "" Then
matchType = 1 'Starts With
actualStr = splitArr(0)
ElseIf UBound(splitArr) = 1 And splitArr(0) = "" Then
matchType = 2 'ends With
actualStr = splitArr(1)
ElseIf UBound(splitArr) = 2 And splitArr(0) = "" And splitArr(2) = ""
Then
matchType = 3 'contains
actualStr = splitArr(1)
Else
MsgBox "Incorrect match provided"
Exit Function
End If
'start index
i = LBound(sourceArr, 1)
'resize array for matched values
ReDim matchArrIndex(LBound(sourceArr, 1) To UBound(sourceArr, 1)) As
Variant
'outer loop
For outerindex = LBound(sourceArr, 1) To UBound(sourceArr, 1)
'inner loop
For innerIndex = LBound(sourceArr, 2) To UBound(sourceArr, 2)
'if string matches with array elements
If (matchType = 0 And sourceArr(outerindex, innerIndex) =
actualStr) Or _
(matchType = 1 And Left(sourceArr(outerindex, innerIndex),
Len(actualStr)) = actualStr) Or _
(matchType = 2 And Right(sourceArr(outerindex,
innerIndex), Len(actualStr)) = actualStr) Or _
(matchType = 3 And InStr(sourceArr(outerindex,
innerIndex), actualStr) <> 0) Then
increaseIndex = True
matchArrIndex(i) = outerindex
End If
Next
If increaseIndex Then
tempArrayIndex = tempArrayIndex + 1
increaseIndex = False
i = i + 1
End If
Next
'if no matches found, exit the function
If tempArrayIndex = 0 Then
Exit Function
End If
If LBound(sourceArr, 1) = 0 Then
tempArrayIndex = tempArrayIndex - 1
End If
'resize temp array
ReDim tempArray(LBound(sourceArr, 1) To tempArrayIndex,
LBound(sourceArr, 2) To UBound(sourceArr, 2)) As Variant
CurrIndex = LBound(sourceArr, 1)
Dim j As Integer
j = LBound(matchArrIndex)
'store values in temp array
For i = CurrIndex To UBound(tempArray)
For innerIndex = LBound(sourceArr, 2) To UBound(sourceArr, 2)
tempArray(i, innerIndex) = sourceArr(matchArrIndex(j),
innerIndex)
Next
j = j + 1
Next
filter2dArray = tempArray
Exit Function
errorHandler:
MsgBox "Error :" & Err.Description
End Function
-----------------------------------------------------------------
How to use it:

Syntax: filter2dArray(myArray, "*Item1*")
This function require 2 parameters.
1). SourceArray 2). MatchString
MatchString parameter can be passed in following 4 switches:
myStr - Exact Match
myStr* - Starts with
*myStr - Ends with
*myStr* - Contains

Limitations: it will not work on one dimensional array.