Extract Array Elements :

Extract Array :

Here is a technique to extract a particular column or Row from a 2D Array

‘==============================================================================

Sub TestOnArray()

    Dim VarArr

    Dim VarArr2

    Dim VarArr3

    Dim blnFilter As Boolean

   

    Application.EnableEvents = False

    VarArr = Range("Range")

    VarArr2 = Application.Index(VarArr, , Range("rngCol").Value)

    Range("rngOutput").CurrentRegion.ClearContents

    If Range("rngCol").Value >= 0 And Range("rngCol").Value <= UBound(VarArr, 2) Then

   

        On Error Resume Next

            VarArr3 = Application.Transpose(Filter(Application.Transpose(VarArr2), Range("rngFiltervalue").Value, blnFilter))

            If IsArray(VarArr3) Then Range("rngOutput").Resize(UBound(VarArr3), UBound(VarArr3, 2)).Value = VarArr3

            Err.Clear

            Debug.Print Err.Description

        On Error GoTo 0

       

    End If

    Application.EnableEvents = True

   

End Sub

‘===========================================================================

‘================================Filter Array========================= 

How to Filter a Particular Column in Array :

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

Sub Test2FilterArray()

   

    Dim VarArrMain

    Dim varArrCol

    Dim VarArrResult

    Dim lngCounter          As Long

    Dim strFilterValue      As String

    Dim lngRowDedim         As Long

    Dim blnFilter As Boolean

   

    If Range("rngFilterType").Value = "Checked" Then blnFilter = True

   

    VarArrMain = Range("Range")

    varArrCol = Application.Index(VarArrMain, , Range("rngCol").Value)

    strFilterValue = Range("rngFiltervalue").Value

    lngRowDedim = 0

    ReDim VarArrResult(lngRowDedim)

   

   

    For lngCounter = LBound(VarArrMain) To UBound(VarArrMain)

            If varArrCol(lngCounter, 1) = strFilterValue And blnFilter Then

           

                    ReDim Preserve VarArrResult(lngRowDedim + 1)

                    strString = Join(Application.Index(VarArrMain, lngCounter), ",")

                    VarArrResult(lngRowDedim) = strString

                    lngRowDedim = lngRowDedim + 1

                   

            ElseIf varArrCol(lngCounter, 1) <> strFilterValue And Not blnFilter Then

               

                    ReDim Preserve VarArrResult(lngRowDedim + 1)

                    strString = Join(Application.Index(VarArrMain, lngCounter), ",")

                    VarArrResult(lngRowDedim) = strString

                    lngRowDedim = lngRowDedim + 1

            End If

    Next lngCounter

   

    Range("rngOutput").CurrentRegion.ClearContents

    Application.EnableEvents = False

    Range("rngOutput").Resize(UBound(VarArrResult) + 1).Value = Application.Transpose(VarArrResult)

    Application.EnableEvents = True

   

    Application.DisplayAlerts = False

        If Range("rngOutput").Value <> "" Then

            Range("rngOutput").CurrentRegion.Columns(1).TextToColumns Destination:=Range("K3"), DataType:=xlDelimited, _

                                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

                                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _

                                :=",", TrailingMinusNumbers:=True

        End If

    Application.DisplayAlerts = True

End Sub

‘============================================================================================ 

This Will work till 65536 Rows Only

Thanks For Reading