slow filtering on table

[niall91]

Hi,

When i import data from an access database to an excel file and create a table I'm having an issue with extremely slow filtering of that table afterwards.
Table is around 3000 rows
I have larger tables on other excel files that are not imported from a database and these filter instantly.
Attached is the sub
Any ideas?

Dim fld As Field
Dim cnt As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Sheet1")
Dim rngTable As Range
Dim headers As Range
Dim list As String, Addr As String
Dim C As Integer
Dim R As Long

'delete table first
sh.Range("A11").CurrentRegion.Delete

Set cnt = New ADODB.Connection
Set rs = New ADODB.Recordset

'connect using database string
    cnt.ConnectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data " & _
    "Source=S:\Fly M.E.S Software\Databases\Order Book Database.accdb;Persist " & _
    "Security Info=False;"

'open the connection
    cnt.Open
'set record set with connection

    With rs
        .ActiveConnection = cnt
        .Source = "select * from Orders"
        .LockType = adLockOptimistic
        .CursorType = adOpenForwardOnly
        .Open
    End With

'set error handler
    On Error GoTo Finish
'loop through record set

    X = 1
    For Each fld In rs.Fields
      sh.Cells(10, X) = fld.Name
      sh.Columns(X).EntireColumn.AutoFit
      X = X + 1 'tick iterator
    Next
    
    Set headers = Sheet1.Range("A10").CurrentRegion
        
'insert data
    Range("A11").CopyFromRecordset rs
    
    Set rngTable = Sheet1.Range("A10").CurrentRegion
    R = rngTable.Rows.Count
    
    rngTable.Interior.Pattern = xlNone
'set table
    sh.ListObjects.Add(xlSrcRange, rngTable).Name = "Orders"
    sh.ListObjects("Orders").TableStyle = "TableStyleMedium14"

'Formating   
    C = findHeaders("Dispatch", headers)
    sh.Range(sh.Cells(11, C), sh.Cells(R + 9, C)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Waiting"""
        rngTable.FormatConditions(1).Interior.Color = RGB(255, 235, 156)
    
    rngTable.FormatConditions.Add Type:=2, Operator:=xlEqual, Formula1:="=$M10=""Finished"""
        rngTable.FormatConditions(2).Interior.Color = RGB(163, 233, 255)
    
    rngTable.FormatConditions.Add Type:=2, Operator:=xlEqual, Formula1:="=$M10=""Cancelled"""
        rngTable.FormatConditions(3).Interior.Color = RGB(231, 230, 230)

'adjusting columns
    sh.Columns(findHeaders("Surf Code", headers)).ColumnWidth = 8
    sh.Columns(findHeaders("Customer Name", headers)).ColumnWidth = 40
    sh.Columns(findHeaders("Customer Reference", headers)).ColumnWidth = 35
    sh.Columns(findHeaders("Customer Reference", headers)).HorizontalAlignment = xlHAlignCenter
    sh.Columns(findHeaders("Finish", headers)).ColumnWidth = 15
    sh.Columns(findHeaders("Description", headers)).ColumnWidth = 30
    sh.Columns(findHeaders("Description", headers)).HorizontalAlignment = xlHAlignCenter

'unlock table
    sh.ListObjects("Orders").Range.Locked = False

'hide columns
    sh.Columns(findHeaders("ID", headers)).Hidden = True
    sh.Columns(findHeaders("Woodparts Reference", headers)).Hidden = True
    sh.Columns(findHeaders("Customer Sub Reference", headers)).Hidden = True
    sh.Columns(findHeaders("Product Category", headers)).Hidden = True

'add data validation
    list = "Finished,In Production,Cancelled"
    
    C = findHeaders("Order Status", headers)

    With sh.Range(sh.Cells(11, C), sh.Cells(R + 9, C)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=list
        .InCellDropdown = True
    End With
    
    C = findHeaders("Dispatch", headers)

    list = "Waiting,Dispatched"
    
    With sh.Range(sh.Cells(11, C), sh.Cells(R + 9, C)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=list
        .InCellDropdown = True
    End With

Finish:
'close the connection
    rs.Close
'close the connection
    cnt.Close
 
    Set cnt = Nothing
    Set rs = Nothing

sh.Protect

End Sub

 

[niall91]

Update:
So when i save and close the workbook and reopen it the filters work perfect (really fast).
Is there a way i can do this without have to close the workbook?

 

[VincentCops]

Hello Niall,
I have similar problems with slow filtering in a table (100cols x 2000 rows).
The calculation is fast enough when changing data. But simple filtering (on value "true" in a calculated column with just boolean values) takes a long time.
Have you found a reason/solution for your problem ?