Speed up Excel Autofilter

I have a workbook that I made which generates a density map of I/O signals in an industrial plant. The whole workbook is driven by the lead sheet which the user inputs the signal type and where it is located. On the worksheet that generates the density map I give the user the ability to click a cell of interest in the density map. when the user clicks the cell a on_selectionChange macro will run computing the location in the plant. The location is than fed into the lead sheets auto filter to show the user what signals are actually at that spot in the plant. My problem is that the location information is computed instantly, but when I go to apply the filter criteria to the autofilter it takes 12 seconds for the filter to apply and the code to change from the density map sheet to the lead database sheet. So does anyone know how I can speed up my code with autofilters. I do turn off screen updating and application calculations when running the macro. This has never been this slow until I started adding other sheets to the workbook. Below you can see my code on how I compute the location. Can someone help me out with this

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    ' Filter the I/O data to those associated with the clicked cell

    ' Turn off screen updating, this speeds up Calc
    Application.ScreenUpdating = False
    ' Turn off automatic calculations
    Application.Calculation = xlCalculationManual

    ' Setup benchmarking
    Dim Time1 As Date
    Time1 = Timer
    Dim Time2 As Date


    Dim rngOLD As Boolean
    Dim rngNEW As Boolean

    Const Building_rng = "C4:K6"
    Const Lvl_rng = "C4:E30"
    Const RL_rng = "C4:C6"
    Const FB_rng = "C4:E4"
    Dim NEW_Offset As Integer
    Dim Extra_Off As Integer
    Dim rowOff As Integer
    Dim colOff As Integer

    ' Define Filter Criteria Variables
    Dim Criteria_Building As String ' Building
    Dim Criteria_lvl As String      ' Building Level
    Dim Criteria_FB As String       ' Front/Back on Level
    Dim Criteria_RL As String       ' Left/Right on Level

    rngOLD = InRange(Target, Worksheets("Density Map").Range("C4:K27"))
    rngNEW = InRange(Target, Worksheets("Density Map").Range("N4:V30,W4:Y12"))

    If (rngOLD Or rngNEW) And Not RangeIsBlank(Target) Then
        If rngNEW Then
            NEW_Offset = 11

            Criteria_Building = FindBuildingionNEW(Target, Union(Range(Building_rng).Offset(0, NEW_Offset), Range("W4:Y6")))

            ' Account for the Extra module in NEW Building
            If Criteria_Building = "Extra" Or Criteria_Building = "5" Or Criteria_Building = "6" Or Criteria_Building = "7" _
               Or Criteria_Building = "8" Or Criteria_Building = "9" Or Criteria_Building = "10" Then
                Extra_Off = 3
            End If
        Else
            Criteria_Building = FindBuildingionOLD(Target, Range(Building_rng))
        End If

        Criteria_lvl = FindLvl(Target, Range(Lvl_rng).Offset(0, NEW_Offset), Criteria_Building)

        ' Get the offsets, Default will return zero if not found
        rowOff = getBuildingionOffset(Criteria_Building) + Extra_Off
        colOff = getLevelOffset(Criteria_lvl)

        Criteria_RL = FindRLFB(Target, Range(RL_rng).Offset(0, NEW_Offset), 1, rowOff, colOff)
        Criteria_FB = FindRLFB(Target, Range(FB_rng).Offset(0, NEW_Offset), 2, rowOff, colOff)

        ' Benchmark
        Debug.Print "1st Half Time: " & Format(Timer - Time1, "00:00")
        Time2 = Timer
        ' End Benchmark

        ' Filter sheet based on click position
        If rngVA Then ' Filter OLD location data
            With Worksheets("IO Data")
                .AutoFilterMode = False
                With .Range("A3:Z3")
                    .AutoFilter
                    .AutoFilter Field:=10, Criteria1:=Criteria_Building
                    .AutoFilter Field:=12, Criteria1:=Criteria_lvl开发者_C百科, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=13, Criteria1:=Criteria_FB, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=14, Criteria1:=Criteria_RL, Operator:=xlOr, Criteria2:=""
                End With
            End With
        Else ' Filter NEW location data
            With Worksheets("IO Data")
                .AutoFilterMode = False
                With .Range("A3:Z3")
                    .AutoFilter
                    .AutoFilter Field:=17, Criteria1:=Criteria_Building
                    .AutoFilter Field:=19, Criteria1:=Criteria_lvl, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=20, Criteria1:=Criteria_FB, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=21, Criteria1:=Criteria_RL, Operator:=xlOr, Criteria2:=""
                End With
            End With
        End If

        ' Turn on automatic calculations
        Application.Calculation = xlCalculationAutomatic
        ' Turn on screen updating
        Application.ScreenUpdating = True

        Worksheets("IO Data").Activate

        ' Benchmark
        Debug.Print "Autofilter Time: " & Format(Timer - Time2, "00:00")
        ' End Benchmark
    End If
End Sub

Inspired by barrowc 's answer, you could try this:

Rather than autofiltering in place, add a report sheet using a 'Get External Data' reference (from the same workbook, in spite of the name!) that returns the required filterd result set.

To set up, add a connectionselect: From Data, Get External Data, Other Sources, Microsoft Query, Excel Files, and select your current workbook. (based on excel 2010, other excel version menus are a little different)

Set up the query on your 'IO data' sheet, and include a WHERE clause (any criteria will do, you will edit this with code later)

Update your _SelectionChange code to modify the connections query

Here's a sample of code to access the connection (this assumes only 1 connection in the workbook, which queries a set of sample data I created to test the performance):

Sub testConnection()
    Dim wb As Workbook
    Dim c As WorkbookConnection
    Dim sql As String
    Dim Time2 As Date

    Time2 = Timer

    Set wb = ActiveWorkbook

    Set c = wb.Connections.Item(1)
    sql = c.ODBCConnection.CommandText
    sql = Replace(sql, "WHERE (`'IO Data$'`.k=10)", _ 
     "WHERE (`'IO Data$'`.k=9) AND (`'IO Data$'`.l=11) AND (`'IO Data$'`.m=12) AND (`'IO Data$'`.n=13)   ")
    c.ODBCConnection.CommandText = sql
    c.Refresh

    Debug.Print "Connection Time: " & Format(Timer - Time2, "00:00")

End Sub

I performed a simple test on a data set of 26 columns, 50,000 rows, all cells containing a simple formula referencing another cell.
Running on Win7 with Office2010, Autofilter took 21seconds to execute, and this method < 1 second

Adapting this to your requirements will be basically building the WHERE clause part of the sql query string, accessed in c.ODBCConnection.CommandText

You might need to look at using ADO to filter the sheet. That should be substantially faster but there's a bit of a learning curve. Start with this overview.

You'll need to add a reference to "Microsoft ActiveX Data Objects 2.8 Library" before you can use ADO