Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports

Results 1 to 1 of 1

Thread: #2 The power of Autofilter in VBA - Part 2

  1. #1
    Join Date
    25th January 2003
    Ístersund, Sweden

    #2 The power of Autofilter in VBA - Part 2

    #1 Let the users only have access to one field for their selection of records.
    We assume here that we have four columns and that the sheet only contains data in the table.

    Option Explicit 
    Sub Hide_Fields() 
        Dim wbBook As Workbook 
        Dim wsSheet As Worksheet 
        Dim rnData As Range 
        Dim i As Long 
        Set wbBook = ThisWorkbook 
        Set wsSheet = wbBook.Worksheets(1) 
        With wsSheet 
            Set rnData = .UsedRange 
        End With 
        For i = 2 To 4 
            rnData.AutoFilter Field:=i, Visibledropdown:=False 
        Next i 
    End Sub 
    #2 Autofilter & Protected worksheet
    If we only want the end-users to filter and view data then we can apply a technique that allow users to do it although the worksheet is protected.

    Depending on the situation it may be necessary to associate the code to other events then what the example use below:

    Option Explicit 
    Private Sub Worksheet_Activate() 
        With Me 
            If .AutoFilterMode = False Then .UsedRange.AutoFilter 
            .Protect UserInterfaceOnly:=True 
            .EnableAutoFilter = True 
        End With 
    End Sub 

    #3 Looping through the collection of fields & conditions
    Sometimes it may be useful to filter the data based on several fields and with one condition per field.

    The following example shows how we can do it quite easily. For the solution to be more flexible, the conditions can be retrieved by letting the users add them via an Inputbox.

    Option Explicit 
    Sub Filter_Multiply_Fields_Conditions() 
        Dim wbBook As Workbook 
        Dim wsSheet As Worksheet 
        Dim rnData As Range 
        Dim vaFields As Variant, vaConditions As Variant 
        Dim i As Long 
         'Here we populate the arrays.
        vaFields = VBA.Array(1, 2, 3, 4) 
        vaConditions = VBA.Array("AA", ">=3", "<>", "<10") 
        Set wbBook = ThisWorkbook 
        Set wsSheet = wbBook.Worksheets("Data") 
        With wsSheet 
            Set rnData = .UsedRange 
        End With 
         'Since both arrays are 0-based we start at 0 and loop through
         'both the collection of fields and conditions.
        For i = 0 To 3 
            rnData.AutoFilter Field:=vaFields(i) , Criteria1:=vaConditions(i) 
        Next i 
    End Sub 
    The third condition in the example, i e "<>", is interpreted by Excel as not empty.

    #4 Delete records (rows)
    There are several situations where we need to delete records, both records that are empty as well as records that contain data we don't want or need to work with.

    The example below shows how to delete records with one condition.

    Option Explicit 
    Sub Delete_Records_Contents() 
        Dim rnData As Range 
        Dim stCondition As String 
        stCondition = "AAA" 
        Application.ScreenUpdating = False 
        With ActiveSheet 
            Set rnData = .UsedRange 
            With rnData 
                .AutoFilter Field:=1, Criteria1:=stCondition 
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _ 
            End With 
            .AutoFilterMode = False 'Turn off the Autofilter.
            .UsedRange 'Restore the used range in the worksheet.
        End With 
        Application.ScreenUpdating = True 
    End Sub 
    Q: How can we delete records that have no data ( i e are empty) in one or several fields?
    A: Use the above approach but replace the condition with "="!

    #5 Do the arithmetic
    Yes, I┤m aware of the so called database-functions that Excel provides, but sometimes we need to do it a little bit different than the "usual way".

    Except for that, I have, lately, become more convinced about the need for doing the aritmethics in VBA than add worksheetfunctions directly into to the worksheets.

    Why? Well, from my point if view there are two major arguments for it:

    When workbooks becomes larger and larger (due to the amount of data involved) we need to re-think how we approach the work to be done. One way is, for example, to avoid adding 1000 complex formulas into one worksheet and only calculate when we need to review the output.

    Many systems produce an output of data that need to be re-arranged, manipulated or filtered before we can do the aritmethic.

    Having said that, it's time for an example!

    Here we assume that we regular import updated data from a system (i e a database) and that the article names also include the sizes of the cloths, like "xxxxxx Size xxx".

    Every size is summarized in two dimensions:
    - The storage-number
    - Number of placed orders

    Option Explicit 
    Sub Count_Numbers() 
        Dim wbBook As Workbook 
        Dim wsSheet As Worksheet 
        Dim rnNumbers As Range, rnOrders As Range, rnSize As Range, rnData As Range 
        Dim vaSize As Variant 
        Dim i As Long, lnNumbers As Long, lnOrders As Long 
        Set wbBook = ThisWorkbook 
        Set wsSheet = wbBook.Worksheets("Sheet1") 
        With wsSheet 
            Set rnSize = .Range("Size") 
            Set rnData = .Range("Numbers") 
            Set rnNumbers = .Range(.Range("C2"), .Range("C65536").End(xlUp)) 
            Set rnOrders = .Range(.Range("D2"), .Range("D65536").End(xlUp)) 
        End With 
        Application.ScreenUpdating = False 
         'Delete previous data.
         'As the names of the different sizes tend to shift we read the valid
         'names from the fixed table's first column, i e they are subject to
         'user's changes.
        vaSize = rnSize.Value 
        For i = 1 To UBound(vaSize) 
             'Create the condition based on each size.
            rnStart.AutoFilter Field:=2, Criteria1:="=*" & vaSize(i, 1) & "*" 
             'Calculate the visible records.
            lnNumbers = Application.WorksheetFunction.Subtotal(9, rnNumbers) 
            lnOrders = Application.WorksheetFunction.Subtotal(9, rnOrders) 
             'Add the numbers to the fixed table.
            With rnSize(i, 1) 
                .Offset(0, 1).Value = lnNumbers 
                .Offset(0, 2).Value = lnOrders 
            End With 
        Next i 
        wsSheet.AutoFilterMode = False 
        Application.ScreenUpdating = True 
    End Sub 
    #6 Transfer & Transform data
    In the last example, which is also the most advanced, the following terms hopefully will explain it.

    We regularly import data into one worksheet. Except for the first column of data, we need to transform the data from columns to rows, when transfering it to a second worksheet.

    The unique collection of items we create from C-column in the first worksheet becomes fieldnames in the second worksheet.

    Option Explicit 
    Sub Transfer_Transform_Data() 
        Dim wbBook As Workbook 
        Dim wsData As Worksheet, wsTransposed As Worksheet 
        Dim rnUnique As Range, rnStart As Range, rnData As Range 
        Dim rnFilter As Range, rnFind As Range, rnSource As Range 
        Dim vaField As Variant 
        Dim i As Long, j As Long 
        Set wbBook = ThisWorkbook 
        With wbBook 
            Set wsData = .Worksheets("Rawdata") 
            Set wsTransposed = .Worksheets("Finalized data") 
        End With 
        With wsData 
            Set rnUnique = .Range(.Range("C1"), .Range("C65536").End(xlUp)) 
            Set rnSource = .Range(.Range("C2"), .Range("C65536").End(xlUp)) 
            Set rnFilter = .Range(.Range("A1"), .Range("D65536").End(xlUp)) 
            Set rnData = .Range("A1") 
        End With 
        With wsTransposed 
            Set rnStart = .Range("A1") 
        End With 
        Application.ScreenUpdating = False 
         'First we sort the table.
        rnFilter.Sort Key1:=Range("C2"), _ 
        Order1:=xlAscending, _ 
        Header:=xlGuess, _ 
        Ordercustom:=1, _ 
        MatchCase:=True, _ 
        Orientation:=xlTopToBottom, _ 
         'Then we create the unique collection of fieldnames.
        rnUnique.AdvancedFilter _ 
        Action:=xlFilterCopy, _ 
        CriteriaRange:=rnUnique, _ 
        CopyToRange:=Range("J1"), _ 
         'Read the unique collection into an array.
        With wsData 
            vaField = .Range(.Range("J2"), .Range("J65536").End(xlUp)) 
        End With 
        With rnStart 
            .Value = "Request_ID" 
             'Add the collection to the first row in the target-worksheet.
            .Offset(0, 1).Resize(1, UBound(vaField)).Value = Application.Transpose(vaField) 
             'Add the Request-ID numbers to the first column in the target-worksheet.
            .Offset(1, 0).Resize(rnUnique.Rows.Count, 1).Value = rnUnique.Offset(1, -2).Value 
        End With 
         'Loop through the collection, set the condition and finally
         'transfer the data into the target-worksheet.
        For i = 1 To UBound(vaField) 
            rnData.AutoFilter Field:=3, Criteria1:=vaField(i, 1) 
            Set rnFind = rnSource.SpecialCells(xlCellTypeVisible) 
            j = rnFind.Rows.Count 
            rnStart.Offset(1, i).Resize(j, 1).Value = rnFind.Offset(0, 1).Value 
        Next i 
        wsData.AutoFilterMode = False 
        Application.ScreenUpdating = False 
        MsgBox "Done!" 
    End Sub 
    Please note that it's faster to transfer values then to copy value from one location to another.

    # Remarks
    Keep in mind that we always need to have fieldnames (i e columnnames) in the first row when working with the Autofilter-tool.

    The Autofilter has one major limitation and that is it can only handle two conditions for each field at the same time.
    This may or may not be a problem but we should be aware of this limitation when we plan to use the AutoFilter in VBA.

    Perhaps it's time for MS to extend the number of conditions in the next coming version.

    # The End - Don't forget to enjoy life - Turn off the computer(s)!

    Enjoy autofiltering!

    Last edited by XL-Dennis; August 20th, 2004 at 00:26.
    Kind regards,

    .NET & Excel | 2nd edition PED | MVP

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts