Saturday, June 2, 2012

Excel VBA – Copy Filtered data using Autofilter in VBA into Array

Autofilter commend can quickly filter out the information satisfied the criteria. Is there some way to select the data that are found after an autofilter using VBA?

Here, I prefer to transfer the data to an array so that I can use them in other calculation.

 Step 1, Autofilter the range
Step 2, Copy the visible cells into the array for further use

The key commend I used here is that If Rng(i,1).Rows.Hidden = False Then Copy the data into the destination array which is transferred into the main sub later.

Sub main()

    Dim FiltResult() As Variant

    Dim Filtersheet As Worksheet

    Dim FiltRange As Range

    Dim FiltField As Integer

    Dim FiltCrit As Variant

    Set Filtersheet = sheets("Sheet1")

    Set FiltRange = Filtersheet.Range("C6:F7380")

    FiltField = 1

    FiltCrit = 910

    FiltResult = Copyfilter(Filtersheet, FiltRange, FiltField, FiltCrit)

    '''''

    ''''Codes related with the filtered result

    ''''

End Sub



Function Copyfilter(Sht As Worksheet, Rng As Range, FField As Integer, Crit As Variant)

         Dim Arr() As Variant

           Sht.Select

         With Sht

          'Remove any existing filters

 Rng.AutoFilter

           RowCount = Rng.Rows.Count

           ColCount = Rng.Columns.Count

           Count = 1

           ReDim Arr(1 To RowCount, 1 To ColCount)

           Rng.AutoFilter Field:=FField, Criteria1:=Crit

            '------Copy the data to array for future use

           For i = 2 To RowCount

                If Rng(i, 1).Rows.Hidden = False Then

                   For j = 1 To ColCount

                   Arr(Count, j) = Rng(i, j).Value

                   Next j

                   Count = Count + 1

                 End If

            Next i

          'Remove the filter

           Rng.AutoFilter

        End With

        '----Transfer the data to the main sub

        Copyfilter = Arr

End Function

                                                                                 © Copyright Exceltipsandkeys All Rights Reserved.

No comments:

Post a Comment