Filter Array : Revised

Here is an faster and easier way to filter 2D Array

Syntex to Use :

FilterArray InputArray, ResultArray, FilterColumn, FilterValue, FilterType

               

==============================================================================

Enum Combination

    xlRow

    xlColumn

End Enum

Enum FltType

    xlFilterEqualTo

    xlFilterLessThen

    xlFilterLessThenEqualTo

    xlFilterGreaterThen

    xlFilterGreaterThenEqualTo

    xlFilterDoesNotEqualTo

    xlFilterContains

    xlFilterDoesNotContain

   

End Enum

============================================================================== 

Function FilterArray(InputArray As Variant, ResultArray As Variant, FilterColumn As Long, FilterValue As Variant, FilterType As FltType) As Boolean

  

' Created by Rajan 11-July-2012

    ' How to Use :

    ' Parameter Info

    ' InputArray : 2D Array which need to be FIlter

    ' ResultArray : in which Filterd Data will be stored

    ' FilterCOlumn : On Which column you want to apply Filter

    ' Filter Type  : Select a Condition

    ' Syntex :

    ' FilterArray InputArray,ResultArray,FilterColumn,"Product1",xlFilterContains

    '

    'if you want to apply Filter on Row , just Transpose the InputArray and Pass in this Function :)

    '           

    Dim blnFlag     As Boolean

    Dim blnMatch    As Boolean

    Dim lngCount    As Long

    Dim lngCount2   As Long

    Dim lngCount3   As Long

    Dim VarTempResult

    Dim VarTEmp

    lngCount2 = 1

   

    If IsArray(InputArray) Then

        If UBound(InputArray) <= 0 Then

            blnFlag = True

            GoTo ExitEarly:

        End If

        Else

        blnFlag = True

        GoTo ExitEarly:

    End If

  

    If FilterValue = "" Then

        blnFlag = True

        GoTo ExitEarly:

    End If

    ReDim VarTEmp(UBound(InputArray))

   

    For lngCount = LBound(InputArray) To UBound(InputArray)

  

        Select Case FilterType

      

            Case xlFilterContains

                If InStr(InputArray(lngCount, FilterColumn), FilterValue) Then blnMatch = True

            Case xlFilterDoesNotContain

                If InStr(InputArray(lngCount, FilterColumn), FilterValue) = 0 Then blnMatch = True

            Case xlFilterDoesNotEqualTo

                If InputArray(lngCount, FilterColumn) <> FilterValue Then blnMatch = True

            Case xlFilterEqualTo

                If InputArray(lngCount, FilterColumn) = FilterValue Then blnMatch = True

            Case xlFilterGreaterThen

                If InputArray(lngCount, FilterColumn) > FilterValue Then blnMatch = True

            Case xlFilterGreaterThenEqualTo

                If InputArray(lngCount, FilterColumn) >= FilterValue Then blnMatch = True

            Case xlFilterLessThen

                If InputArray(lngCount, FilterColumn) < FilterValue Then blnMatch = True

            Case xlFilterLessThenEqualTo

                If InputArray(lngCount, FilterColumn) <= FilterValue Then blnMatch = True

        End Select

   

        If blnMatch Then

            VarTEmp(lngCount2) = lngCount

            lngCount2 = lngCount2 + 1

            blnMatch = False

        End If

    Next

   

    lngCount2 = lngCount2 - 1

    ReDim VarTempResult(1 To lngCount2, 1 To UBound(InputArray, 2))

   

            For lngCount = 1 To lngCount2

                For lngCount3 = 1 To UBound(InputArray, 2)

                    VarTempResult(lngCount, lngCount3) = InputArray(VarTEmp(lngCount), lngCount3)

                Next lngCount3

            Next lngCount

    ResultArray = VarTempResult

  FilterArray=True

ExitEarly:

If blnFlag Then

    FilterArray = False

    ResultArray = Null

End If

End Function

================================================================================

Thanks For reading