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 01: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)

Possible Answers

  1. #2 The power of Autofilter in VBA - Part 1
    By XL-Dennis in forum XL-Dennis corner in the Excel-world
    Replies: 0
    Last Post: May 27th, 2004, 09:22


Posting Permissions

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