#2 The power of Autofilter in VBA - Part 2

[XL-Dennis]

#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) _ 
            .SpecialCells(xlCellTypeVisible).EntireRow.Delete 
        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.
    rnData.ClearContents 
     
     '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, _ 
    DataOption1:=xlSortNormal 
     
     'Then we create the unique collection of fieldnames.
    rnUnique.AdvancedFilter _ 
    Action:=xlFilterCopy, _ 
    CriteriaRange:=rnUnique, _ 
    CopyToRange:=Range("J1"), _ 
    Unique:=True 
     
     '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!

Dennis